Theory Projection

theory Projection
imports Main
begin

(* Projection of an event list onto a subset of the events *)
definition projection:: "'e list  'e set  'e list" (infixl "" 100)
where
"l  E  filter (λx . x  E) l"

(* If projecting on Y yields the empty sequence, then projecting
  on X ∪ Y yields the projection on X. *)
lemma projection_on_union: 
  "l  Y = []  l  (X  Y) = l  X"
proof (induct l)
  case Nil show ?case by (simp add: projection_def)
next
  case (Cons a b) show ?case
  proof (cases "a  Y")
    case True from Cons show "a  Y  (a # b)  (X  Y) = (a # b)  X" 
      by (simp add: projection_def)
  next
    case False from Cons show "a  Y  (a # b)  (X  Y) = (a # b)  X" 
      by (simp add: projection_def)
  qed
qed

(*projection on the empty trace yields the empty trace*)
lemma projection_on_empty_trace: "[]  X =[]" by (simp add: projection_def)

(*projection to the empty set yields the empty trace*)
lemma projection_to_emptyset_is_empty_trace: "l {} = []" by (simp add: projection_def)

(*projection is idempotent*)
lemma projection_idempotent: "l  X= (l X) X" by (simp add: projection_def) 

(*empty projection implies that the trace contains no events of the set the trace is projected to*)
lemma projection_empty_implies_absence_of_events: "l  X = []   X  (set l) = {}" 
 by (metis empty_set inter_set_filter projection_def)

(*subsequently projecting to two disjoint sets yields the empty trace*)
lemma disjoint_projection: "X  Y = {}  (l  X)  Y = []" 
proof -
  assume X_Y_disjoint: "X  Y = {}"
  show "(l  X)  Y = []" unfolding projection_def 
  proof (induct l)
    case Nil show ?case by simp
  next
    case (Cons x xs) show ?case
    proof (cases "x  X")
      case True
      with X_Y_disjoint have "x  Y" by auto
      thus "[x[xx # xs . x  X] . x  Y] = []" using Cons.hyps by auto
    next
      case False show "[x[xx # xs . x  X] . x  Y] = []" using Cons.hyps False by auto
    qed
  qed  
qed      

(* auxiliary lemmas for projection *)
lemma projection_concatenation_commute:
  "(l1 @ l2)  X = (l1  X) @ (l2  X)"
  by (unfold projection_def, auto)

(* Lists that are equal under projection on a set will remain 
equal under projection on a subset. *)
lemma projection_subset_eq_from_superset_eq: 
"((xs  (X  Y)) = (ys  (X  Y)))  ((xs  X) = (ys  X))"
(is "(?L1 = ?L2)  (?L3 = ?L4)")
proof -
  assume prem: "?L1 = ?L2"  
  have "?L1  X = ?L3  ?L2  X = ?L4"
  proof -
    have " a. ((a  X  a  Y)  a  X) = (a  X)" 
      by auto
    thus ?thesis
      by (simp add: projection_def)
  qed   
  with prem show ?thesis
    by auto
qed

(* All elements of a list l are in a set X if and only if
 the projection of l onto X yields l. *)
lemma list_subset_iff_projection_neutral: "(set l  X) = ((l  X) = l)"
(is "?A = ?B")
proof -
  have "?A  ?B"
    proof -
      assume "?A"
      hence "x. x  (set l)  x  X"
        by auto
      thus ?thesis
        by (simp add: projection_def)
    qed
  moreover 
  have "?B  ?A"
    proof -
      assume "?B"
      hence "(set (l  X)) = set l"
        by (simp add: projection_def)
      thus ?thesis
        by (simp add: projection_def, auto)
    qed
  ultimately show ?thesis ..
qed

(* If the projection of τ onto a set X is not the empty trace, then 
there is x ∈ X that is the last occurrence of all elements of X in τ. 
τ can then be split around x.

Expressing non-emptiness in terms of list length is quite useful
for inductive proofs. *)
lemma projection_split_last: "Suc n = length (τ  X)  
 β x α. (x  X  τ = β @ [x] @ α  α  X = []  n = length ((β @ α)  X))"
proof -
  assume Suc_n_is_len_τX: "Suc n = length (τ  X)"

  let ?L = "τ  X"
  let ?RL = "filter (λx . x  X) (rev τ)"

  have "Suc n = length ?RL"
  proof -
    have "rev ?L = ?RL"
      by (simp add: projection_def, rule rev_filter)
    hence "rev (rev ?L) = rev ?RL" ..
    hence "?L = rev ?RL"
      by auto
    with Suc_n_is_len_τX show ?thesis
      by auto
  qed
  with Suc_length_conv[of n ?RL] obtain x xs
    where "?RL = x # xs"
    by auto
  hence "x # xs = ?RL" 
    by auto
  
  from Cons_eq_filterD[OF this] obtain revα revβ
    where "(rev τ) = revα @ x # revβ"
    and revα_no_x: "a  set revα. a  X"
    and x_in_X: "x  X"
    by auto
  hence "rev (rev τ) = rev (revα @ x # revβ)"
    by auto
  hence "τ = (rev revβ) @ [x] @ (rev revα)"
    by auto
  then obtain β α
    where τ_is_βxα: "τ = β @ [x] @ α"
    and α_is_revrevα: "α = (rev revα)"
    and β_is_revrevβ: "β = (rev revβ)"
    by auto
  hence α_no_x: "α  X = []"
  proof -
    from α_is_revrevα revα_no_x have "a  set α. a  X"
      by auto
    thus ?thesis 
      by (simp add: projection_def)
  qed

  have "n = length ((β @ α)  X)"
  proof -
    from α_no_x have αX_zero_len: "length (α  X) = 0"
      by auto

    from x_in_X have xX_one_len: "length ([x]  X) = 1"
      by (simp add: projection_def)

    from τ_is_βxα have "length ?L = length (β  X) + length ([x]  X) + length (α  X)"
      by (simp add: projection_def)            
    with αX_zero_len have "length ?L = length (β  X) + length ([x]  X)"
      by auto
    with xX_one_len Suc_n_is_len_τX have "n = length (β  X)"
      by auto
    with αX_zero_len show ?thesis
      by (simp add: projection_def)
  qed
  with x_in_X τ_is_βxα α_no_x show ?thesis
    by auto
qed

lemma projection_rev_commute:
  "rev (l  X) = (rev l)  X"
  by (induct l, simp add: projection_def, simp add: projection_def)

(* Same as the previous lemma except that we split around the FIRST
    occurrence.

    Note that we do not express non-emptiness via the length function
    simply because there is no need for it in the theories relying on
    this lemma. *)
lemma projection_split_first: " (τ  X) = x # xs    α β. (τ = α @ [x] @ β  α  X = [])"
proof -
  assume τX_is_x_xs: "(τ  X) = x # xs"
  hence "0  length (τ  X)"
    by auto
  hence "0  length (rev (τ  X))"
    by auto
  hence "0  length ((rev τ)  X)"
    by (simp add: projection_rev_commute)
  then obtain n where "Suc n = length ((rev τ)  X)"
    by (auto, metis Suc_pred length_greater_0_conv that)
  from projection_split_last[OF this] obtain β' x' α' 
    where x'_in_X: "x'  X"
    and revτ_is_β'x'α': "rev τ = β' @ [x'] @ α'"
    and α'X_empty: "α'  X = []"
    by auto

  from revτ_is_β'x'α' have "rev (rev τ) = rev (β' @ [x'] @ α')" ..
  hence τ_is_revα'_x'_revβ':"τ = rev α' @ [x'] @ rev β'"
    by auto
  moreover
  from α'X_empty have revα'X_empty: "rev α'  X = []"
    by (metis projection_rev_commute rev_is_Nil_conv)
  moreover
  note x'_in_X
  ultimately have "(τ  X) = x' # ((rev β')  X)"
    by (simp only: projection_concatenation_commute projection_def, auto)
  with τX_is_x_xs have "x = x'"
    by auto
  with τ_is_revα'_x'_revβ' have τ_is_revα'_x_revβ': "τ = rev α' @ [x] @ rev β'"
    by auto
  with revα'X_empty show ?thesis
    by auto
qed

(* this lemma extends the previous lemma by also concluding that the suffix of the splitted trace
   projected is equal to the projection of the initial trace without the first element *)
lemma projection_split_first_with_suffix: 
  " (τ  X) = x # xs    α β. (τ = α @ [x] @ β  α  X = []  β  X = xs)" 
proof -
  assume tau_proj_X: "(τ  X) = x # xs"
  show ?thesis
  proof - 
    from   tau_proj_X have x_in_X: "x  X"
      by (metis IntE inter_set_filter list.set_intros(1) projection_def)
    from  tau_proj_X have  " α β. τ = α @ [x] @ β  α  X = []"
      using projection_split_first by auto
    then obtain α β where tau_split: "τ = α @ [x] @ β"
                      and X_empty_prefix:"α  X = []"
      by auto
    from tau_split tau_proj_X  have  "(α @ [x] @ β)  X =x # xs"
      by auto
    with  X_empty_prefix have  "([x] @ β)  X =x # xs"
      by (simp add: projection_concatenation_commute)   
    hence "(x # β)  X =x # xs"
      by auto
    with  x_in_X have "β  X = xs"
      unfolding projection_def by simp
    with  tau_split X_empty_prefix show ?thesis
      by auto
  qed   
qed




lemma projection_split_arbitrary_element: 
  "τ  X = (α @ [x] @ β)  X; x  X  
        α' β'. (τ = α' @ [x] @ β'  α'  X = α  X  β'  X = β  X)" 
proof -
  assume "τ  X = (α @ [x] @ β)  X"
  and  " x  X"
  { 
    fix n
    have "τ  X = (α @ [x] @ β)  X; x  X; n = length(αX) 
            α' β'. (τ = α' @ [x] @ β'  α'  X = α  X  β'  X = β  X)"
    proof (induct n arbitrary: τ α )
      case 0
      hence "αX = []"
        unfolding projection_def by simp
      with "0.prems"(1) "0.prems"(2) have "τX = x # βX"
        unfolding projection_def by simp
      with αX = [] show ?case
        using projection_split_first_with_suffix by fastforce
    next
      case (Suc n)
      from "Suc.prems"(1) have "τX=αX @ ([x] @ β) X"
        using projection_concatenation_commute by auto
      from "Suc.prems"(3) obtain x' xs' where "α X= x' #xs'"
                                            and "x'  X" 
        by (metis filter_eq_ConsD length_Suc_conv projection_def)
      then obtain a1 a2 where "α = a1 @ [x'] @ a2" 
                         and "a1X = []"
                         and "a2X = xs'" 
        using projection_split_first_with_suffix by metis
      with x'  X "Suc.prems"(1) have "τX= x' #  (a2 @ [x] @ β) X" 
        unfolding projection_def by simp 
      then obtain t1 t2 where "τ= t1 @ [x'] @ t2"
                         and "t1X = []"
                         and "t2X = (a2 @ [x] @ β) X"
        using projection_split_first_with_suffix by metis
      from Suc.prems(3) α X= x' # xs' α = a1 @ [x'] @ a2 a1X = [] a2X = xs'
      have "n=length(a2X)"
        by auto               
      with "Suc.hyps"(1) "Suc.prems"(2) t2X = (a2 @ [x] @ β) X 
        obtain t2' t3' where "t2=t2' @ [x] @ t3'"
                         and "t2'X = a2X"
                         and "t3'X = βX"
          using projection_concatenation_commute by blast
      
      let ?α'="t1 @ [x'] @ t2'" and ?β'="t3'"
      from τ= t1 @ [x'] @ t2 t2=t2' @ [x] @ t3' have "τ=?α'@[x]@?β'"
        by auto
      moreover
      from  α X= x' # xs'  t1X = [] x'  X t2'X = a2X a2X = xs'
      have "?α'X = αX"
        using projection_concatenation_commute unfolding projection_def by simp 
      ultimately
      show ?case using t3'X = βX
        by blast
    qed    
  }
  with τ  X = (α @ [x] @ β)  X x  X show ?thesis
    by simp
qed
        
(* If the projection of a list l onto a set X is empty, it
    will remain empty when projecting further. *)
lemma projection_on_intersection: "l  X = []  l  (X  Y) = []"
(is "?L1 = []  ?L2 = []")
proof -
  assume "?L1 = []"
  hence "set ?L1 = {}" 
    by simp
  moreover
  have "set ?L2  set ?L1"
    by (simp add: projection_def, auto)
  ultimately have "set ?L2 = {}"
    by auto
  thus ?thesis
    by auto
qed

(* The previous lemma expressed with subsets. *)
lemma projection_on_subset: " Y  X; l  X = []   l  Y = []"
proof -
  assume subset: "Y  X"
  assume proj_empty: "l  X = []"
  hence "l  (X  Y) = []"
    by (rule projection_on_intersection)
  moreover
  from subset have "X  Y = Y"
    by auto
  ultimately show ?thesis
    by auto
qed

(* Another variant that is used in proofs of BSP compositionality theorems. *)
lemma projection_on_subset2: " set l  L; l  X' = []; X  L  X'   l  X = []"
proof -
  assume setl_subset_L: "set l  L"
  assume l_no_X': "l  X' = []"
  assume X_inter_L_subset_X': "X  L  X'"

  from X_inter_L_subset_X' l_no_X' have "l  (X  L) = []"
    by (rule projection_on_subset)
  moreover
  have "l  (X  L) = (l  L)  X"
    by (simp add: Int_commute projection_def)
  moreover
  note setl_subset_L
  ultimately show ?thesis
    by (simp add: list_subset_iff_projection_neutral)
qed  

(*If the projection of two lists l1 and l2  onto a set Y is equal then its also equal for all X ⊆ Y*)
lemma non_empty_projection_on_subset: "X  Y  l1  Y = l2  Y   l1  X = l2  X" 
  by (metis projection_subset_eq_from_superset_eq subset_Un_eq)

(* Intersecting a projection set with a list's elements does not change the result
    of the projection. *)
lemma projection_intersection_neutral: "(set l  X)  (l  (X  Y) = l  Y)"
proof -
  assume "set l  X"
  hence "(l  X) = l"
    by (simp add: list_subset_iff_projection_neutral)
  hence "(l  X)  Y = l  Y"
    by simp
  moreover
  have "(l  X)  Y = l  (X  Y)"
    by (simp add: projection_def)
  ultimately show ?thesis
    by simp
qed

lemma projection_commute:
  "(l  X)  Y = (l  Y)  X"
  by (simp add: projection_def conj_commute)


lemma projection_subset_elim: "Y  X  (l  X)  Y = l  Y"
by (simp only: projection_def, metis Diff_subset list_subset_iff_projection_neutral
    minus_coset_filter order_trans projection_commute projection_def)


lemma projection_sequence: "(xs  X)  Y = (xs  (X  Y))"
by (metis Int_absorb inf_sup_ord(1) list_subset_iff_projection_neutral
    projection_intersection_neutral projection_subset_elim)


(* This function yields a possible interleaving for given 
  traces t1 and t2.
  The set A (B) shall denote the the set of events for t1 (t2).
  Non-synchronization events in trace t1 are prioritized. *)
fun merge :: "'e set  'e set  'e list  'e list  'e list"
where
"merge A B [] t2 = t2" |
"merge A B t1 [] = t1" |
"merge A B (e1 # t1') (e2 # t2') = (if e1 = e2 then 
                                          e1 # (merge A B t1' t2')
                                        else (if e1  (A  B) then
                                               e2 # (merge A B (e1 # t1') t2')
                                             else e1 # (merge A B t1' (e2 # t2'))))"

(* If two traces can be interleaved, then merge yields such an interleaving  *)
lemma merge_property: "set t1  A; set t2  B; t1  B = t2  A  
   let t = (merge A B t1 t2) in (t  A = t1  t  B = t2  set t  ((set t1)  (set t2)))"
unfolding Let_def
proof (induct A B t1 t2 rule: merge.induct)
  case (1 A B t2) thus ?case
    by (metis Un_empty_left empty_subsetI list_subset_iff_projection_neutral 
      merge.simps(1) set_empty subset_iff_psubset_eq)
next
  case (2 A B t1) thus ?case
    by (metis Un_empty_right empty_subsetI list_subset_iff_projection_neutral 
      merge.simps(2) set_empty subset_refl)
next
  case (3 A B e1 t1' e2 t2') thus ?case
  proof (cases)
    assume e1_is_e2: "e1 = e2"
    
    note e1_is_e2 
    moreover
    from 3(4) have "set t1'  A"
      by auto
    moreover
    from 3(5) have "set t2'  B"
      by auto
    moreover
    from e1_is_e2 3(4-6) have "t1'  B = t2'  A"
      by (simp add: projection_def)
    moreover
    note 3(1)
    ultimately have ind1: "merge A B t1' t2'  A = t1'"
      and ind2: "merge A B t1' t2'  B = t2'"
      and ind3: "set (merge A B t1' t2')  (set t1')  (set t2')"
      by auto
    
    from e1_is_e2 have merge_eq: 
      "merge A B (e1 # t1') (e2 # t2') = e1 # (merge A B t1' t2')"
      by auto

    from 3(4) ind1 have goal1: 
      "merge A B (e1 # t1') (e2 # t2')  A = e1 # t1'"
      by (simp only: merge_eq projection_def, auto)
    moreover
    from e1_is_e2 3(5) ind2 have goal2: 
      "merge A B (e1 # t1') (e2 # t2')  B = e2 # t2'"
      by (simp only: merge_eq projection_def, auto)
    moreover
    from ind3 have goal3: 
      "set (merge A B (e1 # t1') (e2 # t2'))  set (e1 # t1')  set (e2 # t2')"
      by (simp only: merge_eq, auto)
    ultimately show ?thesis
      by auto (* case (3 e1 t1' e2 t2') for e1 = e2 *)
  next
    assume e1_isnot_e2: "e1  e2"
    show ?thesis
    proof (cases)
      assume e1_in_A_inter_B: "e1  A  B"
      
      from 3(6) e1_isnot_e2 e1_in_A_inter_B have e2_notin_A: "e2  A"
        by (simp add: projection_def, auto)
      
      note e1_isnot_e2 e1_in_A_inter_B 3(4)
      moreover
      from 3(5) have "set t2'  B"
        by auto
      moreover
      from 3(6) e1_isnot_e2 e1_in_A_inter_B have "(e1 # t1')  B = t2'  A"
        by (simp add: projection_def, auto)
      moreover
      note 3(2)
      ultimately have ind1: "merge A B (e1 # t1') t2'  A = (e1 # t1')"
        and ind2: "merge A B (e1 # t1') t2'  B = t2'"
        and ind3: "set (merge A B (e1 # t1') t2')  set (e1 # t1')  set t2'"
        by auto
      
      from e1_isnot_e2 e1_in_A_inter_B 
      have merge_eq: 
        "merge A B (e1 # t1') (e2 # t2') = e2 # (merge A B (e1 # t1') t2')"
        by auto
 
      from e1_isnot_e2 ind1 e2_notin_A have goal1: 
        "merge A B (e1 # t1') (e2 # t2')  A = e1 # t1'"
        by (simp only: merge_eq projection_def, auto)
      moreover
      from 3(5) ind2 have goal2: "merge A B (e1 # t1') (e2 # t2')  B = e2 # t2'"
        by (simp only: merge_eq projection_def, auto)
      moreover
      from 3(5) ind3 have goal3: 
        "set (merge A B (e1 # t1') (e2 # t2'))  set (e1 # t1')  set (e2 # t2')"
        by (simp only: merge_eq, auto)
      ultimately show ?thesis
        by auto (* case (3 e1 t1' e2 t2') for e1 ≠ e2 e1 ∈ A ∩ B *)
    next
      assume e1_notin_A_inter_B: "e1  A  B"
      
      from 3(4) e1_notin_A_inter_B have e1_notin_B: "e1  B"
        by auto
      
      note e1_isnot_e2 e1_notin_A_inter_B
      moreover
      from 3(4) have "set t1'  A"
        by auto
      moreover
      note 3(5)
      moreover
      from 3(6) e1_notin_B have "t1'  B = (e2 # t2')  A"
        by (simp add: projection_def)
      moreover
      note 3(3)
      ultimately have ind1: "merge A B t1' (e2 # t2')  A = t1'"
        and ind2: "merge A B t1' (e2 # t2')  B = (e2 # t2')"
        and ind3: "set (merge A B t1' (e2 # t2'))  set t1'  set (e2 # t2')"
        by auto
      
      from e1_isnot_e2 e1_notin_A_inter_B 
      have merge_eq: "merge A B (e1 # t1') (e2 # t2') = e1 # (merge A B t1' (e2 # t2'))"
        by auto
      
      from 3(4) ind1 have goal1: "merge A B (e1 # t1') (e2 # t2')  A = e1 # t1'"
        by (simp only: merge_eq projection_def, auto)
      moreover
      from ind2 e1_notin_B have goal2: 
        "merge A B (e1 # t1') (e2 # t2')  B = e2 # t2'"
        by (simp only: merge_eq projection_def, auto)
      moreover
      from 3(4) ind3 have goal3: 
        "set (merge A B (e1 # t1') (e2 # t2'))  set (e1 # t1')  set (e2 # t2')"
        by (simp only: merge_eq, auto)
      ultimately show ?thesis
        by auto (* case (3 e1 t1' e2 t2') for e1 ≠ e2 e1 ∉ A ∩ B *)
    qed
  qed
qed

end

Theory Prefix

theory Prefix
imports Main
begin

(* 
  Prefixes and Prefix Closure of traces 
*)
definition prefix :: "'e list  'e list  bool" (infixl "" 100)
where
"(l1  l2)  (l3. l1 @ l3 = l2)" 

definition prefixclosed :: "('e list) set  bool"
where
"prefixclosed tr  (l1  tr. l2. l2  l1  l2  tr)"

(* the empty list is a prefix of every list *)
lemma empty_prefix_of_all: "[]  l" 
  using prefix_def [of "[]" l] by simp

(* the empty list is in any non-empty prefix-closed set *)
lemma empty_trace_contained: " prefixclosed tr ; tr  {}   []  tr"
proof -
  assume 1: "prefixclosed tr" and
         2: "tr  {}"
  then obtain l1 where "l1  tr" 
    by auto
  with 1 have "l2. l2  l1  l2  tr" 
    by (simp add: prefixclosed_def)
  thus "[]  tr" 
    by (simp add: empty_prefix_of_all)
qed

(* the prefix-predicate is transitive *)
lemma transitive_prefix: " l1  l2 ; l2  l3   l1  l3"
  by (auto simp add: prefix_def)

end

Theory EventSystems

theory EventSystems
imports "../Basics/Prefix" "../Basics/Projection"
begin

(* structural representation of event systems *)
record 'e ES_rec =
  E_ES ::  "'e set"
  I_ES ::  "'e set"
  O_ES ::  "'e set"
  Tr_ES :: "('e list) set"

(* syntax abbreviations for ES_rec *)
abbreviation ESrecEES :: "'e ES_rec  'e set"
("E⇘_" [1000] 1000)
where
"EES  (E_ES ES)"

abbreviation ESrecIES :: "'e ES_rec  'e set"
("I⇘_" [1000] 1000)
where
"IES  (I_ES ES)"

abbreviation ESrecOES :: "'e ES_rec  'e set"
("O⇘_" [1000] 1000)
where
"OES  (O_ES ES)"

abbreviation ESrecTrES :: "'e ES_rec  ('e list) set"
("Tr⇘_" [1000] 1000)
where
"TrES  (Tr_ES ES)"

(* side conditions for event systems *)
definition es_inputs_are_events :: "'e ES_rec  bool"
where
"es_inputs_are_events ES  IES  EES"

definition es_outputs_are_events :: "'e ES_rec  bool"
where
"es_outputs_are_events ES  OES  EES"

definition es_inputs_outputs_disjoint :: "'e ES_rec  bool"
where
"es_inputs_outputs_disjoint ES  IES  OES = {}"

definition traces_contain_events :: "'e ES_rec  bool"
where
"traces_contain_events ES  l  TrES. e  (set l). e  EES"

definition traces_prefixclosed :: "'e ES_rec  bool"
where
"traces_prefixclosed ES  prefixclosed TrES"

definition ES_valid :: "'e ES_rec  bool"
where
"ES_valid ES  
  es_inputs_are_events ES  es_outputs_are_events ES 
   es_inputs_outputs_disjoint ES  traces_contain_events ES 
   traces_prefixclosed ES"

(* Event systems are instances of ES_rec that satisfy ES_valid. *)

(* Totality of an event system ES with respect to a set E *)
definition total :: "'e ES_rec  'e set  bool"
where
"total ES E  E  EES  (τ  TrES. e  E. τ @ [e]  TrES)"

lemma totality: " total ES E; t  TrES; set t'  E   t @ t'  TrES"
  by (induct t' rule: rev_induct, force, simp only: total_def, auto)


(* structural representation of composed event systems (composition operator) *)
definition composeES :: "'e ES_rec  'e ES_rec  'e ES_rec" 
where
"composeES ES1 ES2   
    
    E_ES  = EES1  EES2, 
    I_ES  = (IES1 - OES2)  (IES2 - OES1),
    O_ES  = (OES1 - IES2)  (OES2 - IES1),
    Tr_ES = {τ . (τ  EES1)  TrES1  (τ  EES2)  TrES2 
                   (set τ  EES1  EES2)} 
  "

abbreviation composeESAbbrv :: "'e ES_rec  'e ES_rec  'e ES_rec"
("_  _"[1000] 1000)
where
"ES1  ES2  (composeES ES1 ES2)"

definition composable :: "'e ES_rec  'e ES_rec  bool"
where
"composable ES1 ES2  (EES1  EES2)  ((OES1  IES2)  (OES2  IES1))"


(* composing two event systems yields an event system *)
lemma composeES_yields_ES: 
  " ES_valid ES1; ES_valid ES2   ES_valid (ES1  ES2)"
  unfolding ES_valid_def
proof (auto)
  assume ES1_inputs_are_events: "es_inputs_are_events ES1"
  assume ES2_inputs_are_events: "es_inputs_are_events ES2"
  show "es_inputs_are_events (ES1  ES2)" unfolding composeES_def es_inputs_are_events_def
    proof (simp)
      have subgoal11: "IES1 - OES2  EES1  EES2"
      proof (auto)
        fix x
        assume "x  IES1"
        with ES1_inputs_are_events  show "x  EES1" 
          by (auto simp add: es_inputs_are_events_def)
      qed
      have subgoal12: "IES2 - OES1  EES1  EES2"    
      proof (rule subsetI, rule UnI2, auto)
        fix x
        assume "x  IES2"
        with ES2_inputs_are_events show "x  EES2" 
          by (auto simp add: es_inputs_are_events_def)
      qed
      from subgoal11 subgoal12 
      show "IES1 - OES2  EES1  EES2  IES2 - OES1  EES1  EES2" ..
  qed
next
  assume ES1_outputs_are_events: "es_outputs_are_events ES1"
  assume ES2_outputs_are_events: "es_outputs_are_events ES2"
  show "es_outputs_are_events (ES1  ES2)" 
    unfolding composeES_def es_outputs_are_events_def
    proof (simp)
      have subgoal21: "OES1 - IES2  EES1  EES2"
      proof (auto)
        fix x
        assume "x  OES1"
        with ES1_outputs_are_events  show "x  EES1" 
          by (auto simp add: es_outputs_are_events_def)
      qed
      have subgoal22: "OES2 - IES1  EES1  EES2"    
      proof (rule subsetI, rule UnI2, auto)
        fix x
        assume "x  OES2"
        with ES2_outputs_are_events show "x  EES2" 
          by (auto simp add: es_outputs_are_events_def)
      qed
      from subgoal21 subgoal22 
      show "OES1 - IES2  EES1  EES2  OES2 - IES1  EES1  EES2" ..
  qed
next
  assume ES1_inputs_outputs_disjoint: "es_inputs_outputs_disjoint ES1"
  assume ES2_inputs_outputs_disjoint: "es_inputs_outputs_disjoint ES2"
  show "es_inputs_outputs_disjoint (ES1  ES2)" 
    unfolding composeES_def es_inputs_outputs_disjoint_def
    proof (simp)
      have subgoal31:
        "{}  (IES1 - OES2  (IES2 - OES1))  (OES1 - IES2  (OES2 - IES1))" 
        by auto
      have subgoal32:
        "(IES1 - OES2  (IES2 - OES1))  (OES1 - IES2  (OES2 - IES1))  {}"
      proof (rule subsetI, erule IntE)
      fix x
      assume ass1: "x  IES1 - OES2  (IES2 - OES1)"
      then have ass1': "x  IES1 - OES2  x  (IES2 - OES1)" 
        by auto
      assume ass2: "x  OES1 - IES2  (OES2 - IES1)"
      then have ass2':"x  OES1 - IES2  x  (OES2 - IES1)" 
        by auto
      note ass1'
      moreover {
        assume left1: "x  IES1 - OES2"
        note ass2'
        moreover {
          assume left2: "x  OES1 - IES2"
          with left1 have "x (IES1)  (OES1)" 
            by (auto)
          with ES1_inputs_outputs_disjoint have "x{}" 
            by (auto simp add: es_inputs_outputs_disjoint_def)
        }
        moreover {
          assume right2: "x  (OES2 - IES1)"
          with left1 have "x (IES1 - IES1)" 
            by auto
          hence "x{}" 
            by auto                
        }
        ultimately have "x{}" ..
      }
      moreover {
        assume right1: "x  IES2 - OES1"
        note ass2'
        moreover {
          assume left2: "x  OES1 - IES2"
          with right1 have "x (IES2 - IES2)" 
            by auto
          hence "x{}" 
            by auto
        }
        moreover {
          assume right2: "x  (OES2 - IES1)"
          with right1 have "x  (IES2  OES2)" 
            by auto
          with ES2_inputs_outputs_disjoint have "x{}" 
            by (auto simp add: es_inputs_outputs_disjoint_def)
        }
        ultimately have "x{}" ..
      }
      ultimately show "x{}" ..
    qed

    from subgoal31 subgoal32 
    show "(IES1 - OES2  (IES2 - OES1))  (OES1 - IES2  (OES2 - IES1)) = {}" 
      by auto
  qed
next
  show "traces_contain_events (ES1  ES2)" unfolding composeES_def traces_contain_events_def
    proof (clarsimp)
      fix l e
      assume "e  set l"
        and "set l  EES1  EES2"
      then have e_in_union: "e  EES1  EES2" 
        by auto
      assume "e  EES2"
      with e_in_union show "e  EES1" 
        by auto
    qed
next
  assume ES1_traces_prefixclosed: "traces_prefixclosed ES1"
  assume ES2_traces_prefixclosed: "traces_prefixclosed ES2"
  show "traces_prefixclosed (ES1  ES2)" 
    unfolding composeES_def traces_prefixclosed_def prefixclosed_def prefix_def
  proof (clarsimp)
    fix l2 l3
    have l2l3split: "(l2 @ l3)  EES1 = (l2  EES1) @ (l3  EES1)" 
      by (rule projection_concatenation_commute)
    assume "(l2 @ l3)  EES1  TrES1"
    with l2l3split have l2l3cattrace: "(l2  EES1) @ (l3  EES1)  TrES1" 
      by auto
    have theprefix: "(l2  EES1)  ((l2  EES1) @ (l3  EES1))" 
      by (simp add: prefix_def)
    have prefixclosure: " es1  (TrES1).  es2. es2  es1  es2  (TrES1)" 
      by (clarsimp, insert ES1_traces_prefixclosed, unfold traces_prefixclosed_def prefixclosed_def, 
        erule_tac x="es1" in ballE, erule_tac x="es2" in allE, erule impE, auto)
    hence 
      " ((l2  EES1) @ (l3  EES1))  TrES1   es2. es2  ((l2  EES1) @ (l3  EES1))
          es2  TrES1" ..
    with l2l3cattrace have " es2. es2  ((l2  EES1) @ (l3  EES1))  es2  TrES1" 
      by auto
    hence "(l2  EES1)  ((l2  EES1) @ (l3  EES1))  (l2  EES1)  TrES1" ..
    with theprefix have goal51: "(l2  EES1)  TrES1" 
      by simp
    have l2l3split: "(l2 @ l3)  EES2 = (l2  EES2) @ (l3  EES2)" 
      by (rule projection_concatenation_commute)
    assume "(l2 @ l3)  EES2  TrES2"
    with l2l3split have l2l3cattrace: "(l2  EES2) @ (l3  EES2)  TrES2" 
      by auto
    have theprefix: "(l2  EES2)  ((l2  EES2) @ (l3  EES2))" 
      by (simp add: prefix_def)
    have prefixclosure: " es1  TrES2. es2. es2  es1  es2  TrES2" 
      by (clarsimp, insert ES2_traces_prefixclosed, 
        unfold traces_prefixclosed_def prefixclosed_def, 
        erule_tac x="es1" in ballE, erule_tac x="es2" in allE, erule impE, auto)
    hence " ((l2  EES2) @ (l3  EES2))  TrES2 
        es2. es2  ((l2  EES2) @ (l3  EES2))  es2  TrES2" ..
    with l2l3cattrace have " es2. es2  ((l2  EES2) @ (l3  EES2))  es2  TrES2" 
      by auto
    hence "(l2  EES2)  ((l2  EES2) @ (l3  EES2))  (l2  EES2)  TrES2" ..
    with theprefix have goal52: "(l2  EES2)  TrES2" 
      by simp
    from goal51 goal52 show goal5: "l2  EES1  TrES1  l2  EES2  TrES2" .. 
  qed
qed

end 

Theory StateEventSystems

theory StateEventSystems
imports EventSystems
begin

(* structural representation of state event systems *)
record ('s, 'e) SES_rec = 
  S_SES ::  "'s set"
  s0_SES :: "'s"
  E_SES ::  "'e set"
  I_SES ::  "'e set"
  O_SES ::  "'e set"
  T_SES ::  "'s  'e  's"

(* syntax abbreviations for SES_rec *)
abbreviation SESrecSSES :: "('s, 'e) SES_rec  's set"
("S⇘_" [1000] 1000)
where
"SSES  (S_SES SES)"

abbreviation SESrecs0SES :: "('s, 'e) SES_rec  's"
("s0⇘_" [1000] 1000)
where
"s0SES  (s0_SES SES)"

abbreviation SESrecESES :: "('s, 'e) SES_rec  'e set"
("E⇘_" [1000] 1000)
where
"ESES  (E_SES SES)"

abbreviation SESrecISES :: "('s, 'e) SES_rec  'e set"
("I⇘_" [1000] 1000)
where
"ISES  (I_SES SES)"

abbreviation SESrecOSES :: "('s, 'e) SES_rec  'e set"
("O⇘_" [1000] 1000)
where
"OSES  (O_SES SES)"

abbreviation SESrecTSES :: "('s, 'e) SES_rec  ('s  'e  's)"
("T⇘_" [1000] 1000)
where
"TSES  (T_SES SES)"

abbreviation TSESpred :: "'s  'e  ('s, 'e) SES_rec  's  bool"
("_ _⟶⇘_ _" [100,100,100,100] 100)
where
"s eSES s'  (TSES s e = Some s')"

(* side conditions for state event systems *)
definition s0_is_state :: "('s, 'e) SES_rec  bool"
where
"s0_is_state SES  s0SES  SSES"

definition ses_inputs_are_events :: "('s, 'e) SES_rec  bool"
where
"ses_inputs_are_events SES  ISES  ESES"

definition ses_outputs_are_events :: "('s, 'e) SES_rec  bool"
where
"ses_outputs_are_events SES  OSES  ESES"

definition ses_inputs_outputs_disjoint :: "('s, 'e) SES_rec  bool"
where
"ses_inputs_outputs_disjoint SES  ISES  OSES = {}"

definition correct_transition_relation :: "('s, 'e) SES_rec  bool"
where
"correct_transition_relation SES 
 x y z. x ySES z  ((x  SSES)  (y  ESES)  (z  SSES))"

(* State event systems are instances of SES_rec that satisfy SES_valid. *)
definition SES_valid :: "('s, 'e) SES_rec  bool"
where
"SES_valid SES  
  s0_is_state SES  ses_inputs_are_events SES 
   ses_outputs_are_events SES  ses_inputs_outputs_disjoint SES 
  correct_transition_relation SES"

(* auxiliary definitions for state event systems *)

(* Paths in state event systems *)
primrec path :: "('s, 'e) SES_rec  's  'e list  's" 
where
path_empt: "path SES s1 [] = (Some s1)" |
path_nonempt: "path SES s1 (e # t) = 
  (if (s2. s1 eSES s2) 
  then (path SES (the (TSES s1 e)) t) 
  else None)" 

abbreviation pathpred :: "'s  'e list  ('s, 'e) SES_rec  's  bool"
("_ _⟹⇘_ _" [100, 100, 100, 100] 100)
where
"s tSES s'  path SES s t = Some s'"

(* A state s is reachable in a state event system if there is a path from the initial state
of the state event system to state s. *)
definition reachable :: "('s, 'e) SES_rec  's  bool" 
where
"reachable SES s  (t. s0SES tSES s)"

(* A trace t is enabled in a state s if there is a path t from s to some other state.*)
definition enabled :: "('s, 'e) SES_rec  's  'e list  bool"
where
"enabled SES s t  (s'. s tSES s')"

(* The set of possible traces in a state event system SES is the set of traces that are enabled in
the initial state of SES. *)
definition possible_traces :: "('s, 'e) SES_rec  ('e list) set"
where
"possible_traces SES  {t. (enabled SES s0SES t)}"

(* structural representation of the event system induced by a state event system *) 
definition induceES :: "('s, 'e) SES_rec  'e ES_rec"
where
"induceES SES  
  
  E_ES = ESES, 
  I_ES = ISES, 
  O_ES  = OSES, 
  Tr_ES = possible_traces SES 
 "
(* auxiliary lemmas for state event systems *)

(* If some event sequence is not enabled in a state,
  then it will not become possible by appending events. *)
lemma none_remains_none : " s e. (path SES s t) = None 
   (path SES s (t @ [e])) = None"
  by (induct t, auto)

(* If some event sequence t is enabled in a state s in which
 some event e is not enabled, then the event sequence
 obtained by appending e to t is not enabled in s. *)
lemma path_trans_single_neg: " s1. s1 tSES s2; ¬ (s2 eSES sn) 
      ¬ (s1 (t @ [e])SES sn)"
    by (induct t, auto)

(* If the event sequence t:e is enabled in some state, then 
  the event sequence t is also enabled and results in some state t' *)
lemma path_split_single: "s1 (t@[e])SES sn 
   s'. s1 tSES s'   s' eSES sn"
  by (cases "path SES s1 t", simp add: none_remains_none,
    simp, rule ccontr, auto simp add: path_trans_single_neg)


(* If an event sequence results in a state s', from which the event e results in sn,
  then the combined event sequence also results in sn *)
lemma path_trans_single: "s.  s tSES s'; s' eSES sn  
   s (t @ [e])SES sn"
proof (induct t)
  case Nil thus ?case by auto
next
  case (Cons a t) thus ?case
  proof -
    from Cons obtain s1' where trans_s_a_s1': "s aSES s1'" 
      by (simp, split if_split_asm, auto)
    with Cons have "s1' (t @ [e])SES sn" 
      by auto
    with trans_s_a_s1' show ?thesis 
      by auto
  qed
qed

(* We can split a path from s1 to sn via the event sequence t1:t2
 into two paths from s1 to s2 via t1 and from s2 to sn via t2  *)
lemma path_split: " sn.  s1 (t1 @ t2)SES sn  
   (s2. (s1 t1SES s2  s2 t2SES sn))"
proof (induct t2 rule: rev_induct)
  case Nil thus ?case by auto
next
  case (snoc a t) thus ?case
  proof -
    from snoc have "s1 (t1 @ t @ [a])SES sn" 
      by auto
    hence "sn'. s1 (t1 @ t)SES sn'  sn' aSES sn" 
      by (simp add: path_split_single)
    then obtain sn' where path_t1_t_trans_a: 
      "s1 (t1 @ t)SES sn'  sn' aSES sn" 
      by auto
    with snoc obtain s2 where path_t1_t: 
      "s1 t1SES s2  s2 tSES sn'" 
      by auto
    with path_t1_t_trans_a have "s2 (t @ [a])SES sn" 
      by (simp add: path_trans_single)
    with path_t1_t show ?thesis by auto
  qed
qed

(* Two paths can be concatenated. *)
lemma path_trans: 
"sn.  s1 l1SES s2; s2 l2SES sn   s1 (l1 @ l2)SES sn"
proof (induct l2 rule: rev_induct)
  case Nil thus ?case by auto
next
  case (snoc a l) thus ?case
  proof -
    assume path_l1: "s1 l1SES s2"
    assume "s2 (l@[a])SES sn"
    hence "sn'. s2 lSES sn'  sn' [a]SES sn" 
      by (simp add: path_split del: path_nonempt)
    then obtain sn' where path_l_a: "s2 lSES sn'  sn' [a]SES sn" 
      by auto
    with snoc path_l1 have path_l1_l: "s1 (l1@l)SES sn'" 
      by auto
    with path_l_a have "sn' aSES sn" 
      by (simp, split if_split_asm, auto)
    with path_l1_l show "s1 (l1 @ l @ [a])SES sn" 
      by (subst append_assoc[symmetric], rule_tac s'="sn'" in path_trans_single, auto)
  qed
qed	


(* The prefix of an enabled trace is also enabled. (This lemma cuts of the last element.) *)
lemma enabledPrefixSingle : " enabled SES s (t@[e])   enabled SES s t"
unfolding enabled_def
proof -
  assume ass: "s'. s (t @ [e])SES s'"
  from ass obtain s' where "s (t @ [e])SES s'" ..
  hence "t'. (s tSES t')  (t' eSES s')" 
    by (rule path_split_single)
  then obtain t' where "s tSES t'" 
    by (auto)
  thus "s'. s tSES s'" ..
qed


(* The prefix of an enabled trace is also enabled.
    (This lemma cuts of a suffix trace.) *)
lemma enabledPrefix : " enabled SES s (t1 @ t2)   enabled SES s t1"
  unfolding enabled_def
proof - 
  assume ass: "s'. s (t1 @ t2)SES s'"
  from ass obtain s' where "s (t1 @ t2)SES s'" ..
  hence "t. (s t1SES t  t t2SES s')" 
    by (rule path_split)
  then obtain t where "s t1SES t" 
    by (auto)
  then show "s'. s t1SES s'" ..
qed


(* The last element of an enabled trace makes a transition between two states. *)
lemma enabledPrefixSingleFinalStep : " enabled SES s (t@[e])    t' t''. t' eSES t''"
  unfolding enabled_def
proof -
  assume ass: "s'. s (t @ [e])SES s'" 
  from ass obtain s' where "s (t @ [e])SES s'" .. 
  hence "t'. (s tSES t')   (t' eSES s')" 
    by (rule path_split_single)
  then obtain t' where "t' eSES s'" 
    by (auto)
  thus "t' t''. t' eSES t''" 
    by (auto)
qed


(* applying induceES on a state event system yields an event system *)
lemma induceES_yields_ES: 
  "SES_valid SES  ES_valid (induceES SES)"
proof (simp add: SES_valid_def ES_valid_def, auto)
  assume SES_inputs_are_events: "ses_inputs_are_events SES"
  thus "es_inputs_are_events (induceES SES)"
    by (simp add: induceES_def ses_inputs_are_events_def es_inputs_are_events_def)
next
  assume SES_outputs_are_events: "ses_outputs_are_events SES"
  thus "es_outputs_are_events (induceES SES)"
    by (simp add: induceES_def ses_outputs_are_events_def es_outputs_are_events_def)
next
  assume SES_inputs_outputs_disjoint: "ses_inputs_outputs_disjoint SES"
  thus "es_inputs_outputs_disjoint (induceES SES)"
    by (simp add: induceES_def ses_inputs_outputs_disjoint_def es_inputs_outputs_disjoint_def)
next
  assume SES_correct_transition_relation: "correct_transition_relation SES"
  thus "traces_contain_events (induceES SES)"
      unfolding induceES_def traces_contain_events_def possible_traces_def
    proof (auto)
    fix l e
    assume enabled_l: "enabled SES s0SES l"
    assume e_in_l: "e  set l"
    from enabled_l e_in_l show "e  ESES"
    proof (induct l rule: rev_induct)
      case Nil 
        assume e_in_empty_list: "e  set []" 
        hence f: "False"
          by (auto) 
        thus ?case 
          by auto
      next
      case (snoc a l)
      from snoc.prems have l_enabled: "enabled SES s0SES l"
        by (simp add: enabledPrefixSingle)
        show ?case
          proof  (cases "e  (set l)")
            from snoc.hyps l_enabled show "e  set l  e  ESES"
              by auto
            show "e  set l  e  ESES"
              proof -
                assume "e  set l"
                with snoc.prems have e_eq_a : "e=a"
                  by auto
                from snoc.prems have " t t'. t aSES t'" 
                  by (auto simp add: enabledPrefixSingleFinalStep)
                then obtain t t' where "t aSES t'"
                  by auto
                with e_eq_a SES_correct_transition_relation show "e  ESES" 
                  by (simp add: correct_transition_relation_def)
             qed
         qed
      qed
   qed
next
  show "traces_prefixclosed (induceES SES)"
    unfolding traces_prefixclosed_def prefixclosed_def induceES_def possible_traces_def prefix_def
    by (clarsimp simp add: enabledPrefix)
qed

end

Theory Views

theory Views
imports Main
begin

(* structural representation of views *)
record 'e V_rec =
  V :: "'e set"
  N :: "'e set"
  C :: "'e set"

(* syntax abbreviations for V_rec *)
abbreviation VrecV :: "'e V_rec  'e set"
("V⇘_" [100] 1000)
where
"Vv  (V v)"

abbreviation VrecN :: "'e V_rec  'e set"
("N⇘_" [100] 1000)
where
"Nv  (N v)"

abbreviation VrecC :: "'e V_rec  'e set"
("C⇘_" [100] 1000)
where
"Cv  (C v)"

(* side conditions for views *)
definition VN_disjoint :: "'e V_rec  bool"
where
"VN_disjoint v  Vv  Nv = {}"

definition VC_disjoint :: "'e V_rec  bool"
where
"VC_disjoint v  Vv  Cv = {}"

definition NC_disjoint :: "'e V_rec  bool"
where
"NC_disjoint v  Nv  Cv = {}"

(* Views are instances of V_rec that satisfy V_valid. *)
definition V_valid :: "'e V_rec  bool"
where
"V_valid  v  VN_disjoint v  VC_disjoint v  NC_disjoint v"

(* A view is a view on a set of events iff it covers exactly those events and is a valid view*)
definition isViewOn :: "'e V_rec  'e set  bool" 
where
"isViewOn 𝒱 E  V_valid 𝒱  V𝒱  N𝒱  C𝒱 = E"

end

Theory FlowPolicies

theory FlowPolicies
imports Views
begin

(* 
  Flow policies
*)
record 'domain FlowPolicy_rec = 
  D :: "'domain set"
  v_rel :: "('domain × 'domain) set"
  n_rel :: "('domain × 'domain) set"
  c_rel :: "('domain × 'domain) set"
(*
  The three relations of a flow policy form a partition of DxD.
  Moreover, the relation v_rel is reflexive.
*)
definition FlowPolicy :: "'domain FlowPolicy_rec  bool"
where
"FlowPolicy fp  
   ((v_rel fp)  (n_rel fp)  (c_rel fp) = ((D fp) × (D fp)))
  (v_rel fp)  (n_rel fp) = {}
  (v_rel fp)  (c_rel fp) = {}
  (n_rel fp)  (c_rel fp) = {} 
  (d  (D fp). (d, d)  (v_rel fp))"

(* 
  Domain assignments and the view of a domain 
*)
type_synonym ('e, 'domain) dom_type = "'e  'domain"

(*
  A domain assignment should only assign domains to actual events.
*)
definition dom :: "('e, 'domain) dom_type  'domain set  'e set  bool"
where
"dom domas dset es  
(e. d. ((domas e = Some d)  (e  es  d  dset)))"

(*
  The combination of a domain assignment and a flow policy
  yields a view for each domain.
*)
definition view_dom :: "'domain FlowPolicy_rec  'domain  ('e, 'domain) dom_type  'e V_rec"
where
  "view_dom fp d domas  
    V = {e. d'. (domas e = Some d'  (d', d)  (v_rel fp))}, 
     N = {e. d'. (domas e = Some d'  (d', d)  (n_rel fp))}, 
     C = {e. d'. (domas e = Some d'  (d', d)  (c_rel fp))} "

end

Theory BasicSecurityPredicates

theory BasicSecurityPredicates
imports Views "../Basics/Projection"
begin

(*Auxiliary predicate capturing that a a set of traces consists 
only of traces of a given set of events *)
definition areTracesOver :: "('e list) set  'e set  bool "
where
"areTracesOver Tr E  
   τ  Tr. (set τ)  E"



(* Basic Security Predicates are properties of sets of traces
 that are parameterized with a view *)
type_synonym 'e BSP = "'e V_rec  (('e list) set)  bool"

(* Basic Security Predicates are valid if and only if they are closure property of sets of traces 
for arbitrary views and sets of traces *)
definition BSP_valid :: "'e BSP  bool"
where 
"BSP_valid bsp  
  𝒱 Tr E. ( isViewOn 𝒱 E  areTracesOver Tr E ) 
               ( Tr'. Tr'  Tr   bsp 𝒱 Tr')"

(* Removal of Confidential Events (R) *)
definition R :: "'e BSP"
where
"R 𝒱 Tr  
  τTr. τ'Tr. τ'  C𝒱 = []  τ'  V𝒱 = τ  V𝒱"

lemma BSP_valid_R: "BSP_valid R" 
proof -
  {  
    fix 𝒱::"('e V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr" 
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "R 𝒱 ?Tr'" 
      proof -
        {
          fix τ
          assume "τ  {t. (set t)  E}"
          let ?τ'="τ(V𝒱)"
          have "?τ'  C𝒱 = []   ?τ'  V𝒱 = τ  V𝒱" 
            using ‹isViewOn 𝒱 E  disjoint_projection projection_idempotent 
            unfolding isViewOn_def V_valid_def VC_disjoint_def  by metis
          moreover
          from τ  {t. (set t)  E} have "?τ'  ?Tr'" using ‹isViewOn 𝒱 E
            unfolding isViewOn_def
            by (simp add: list_subset_iff_projection_neutral projection_commute) 
          ultimately 
          have " τ'{t. set t  E}. τ'  C𝒱 = []  τ'  V𝒱 = τ  V𝒱" 
            by auto
        }
        thus ?thesis unfolding R_def
          by auto
      qed  
    ultimately
    have  " Tr'. Tr'  Tr   R 𝒱 Tr'"
      by auto
  }
  thus ?thesis 
    unfolding BSP_valid_def by auto
qed
    
(* Deletion of Confidential Events (D) *)
definition D :: "'e BSP"
where
"D 𝒱 Tr  
  α β. cC𝒱. ((β @ [c] @ α)  Tr  αC𝒱 = []) 
     (α' β'. ((β' @ α')  Tr  α'V𝒱 = αV𝒱  α'C𝒱 = []
                   β'(V𝒱  C𝒱) = β(V𝒱  C𝒱)))"

lemma BSP_valid_D: "BSP_valid D"
proof -
  {  
    fix 𝒱::"('e V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr" 
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "D 𝒱 ?Tr'"
      unfolding D_def by auto
    ultimately
    have  " Tr'. Tr'  Tr   D 𝒱 Tr'" 
      by auto
  }
  thus ?thesis 
    unfolding BSP_valid_def by auto
qed

(* Insertion of Confidential Events (I) *)
definition I :: "'e BSP"
where
"I 𝒱 Tr  
  α β. cC𝒱. ((β @ α)  Tr  αC𝒱 = []) 
     (α' β'. ((β' @ [c] @ α')  Tr  α'V𝒱 = αV𝒱  α'C𝒱 = []
                      β'(V𝒱  C𝒱) = β(V𝒱  C𝒱)))"

lemma BSP_valid_I: "BSP_valid I"
proof -
  {  
    fix 𝒱::"('e V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr"
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "I 𝒱 ?Tr'" using ‹isViewOn 𝒱 E 
      unfolding isViewOn_def I_def by auto
    ultimately
    have  " Tr'. Tr'  Tr   I 𝒱 Tr'"
      by auto
  }
  thus ?thesis
    unfolding BSP_valid_def by auto
qed


(* ρ-Admissibility *)
type_synonym 'e Rho = "'e V_rec  'e set"

definition 
Adm :: "'e V_rec  'e Rho  ('e list) set  'e list  'e  bool"
where 
"Adm 𝒱 ρ Tr β e 
   γ. ((γ @ [e])  Tr  γ(ρ 𝒱) = β(ρ 𝒱))"

(* Insertion of Admissible Confidential Events (IA) *)
definition IA :: "'e Rho  'e BSP"
where
"IA ρ 𝒱 Tr  
  α β. cC𝒱. ((β @ α)  Tr  αC𝒱 = []  (Adm 𝒱 ρ Tr β c)) 
     ( α' β'. ((β' @ [c] @ α')  Tr)  α'V𝒱 = αV𝒱 
                     α'C𝒱 = []  β'(V𝒱  C𝒱) = β(V𝒱  C𝒱))" 

lemma BSP_valid_IA: "BSP_valid (IA ρ) "
proof -
  {  
    fix 𝒱 :: "('a V_rec)"
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr"
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "IA ρ 𝒱 ?Tr'" using ‹isViewOn 𝒱 E
      unfolding isViewOn_def IA_def by auto
    ultimately
    have  " Tr'. Tr'  Tr   IA ρ 𝒱 Tr'"
      by auto
  }
  thus ?thesis
    unfolding BSP_valid_def by auto
qed


(* Backwards Strict Deletion of Confidential Events (BSD) *)
definition BSD :: "'e BSP"
where
"BSD 𝒱 Tr  
  α β. cC𝒱. ((β @ [c] @ α)  Tr  αC𝒱 = []) 
     (α'. ((β @ α')  Tr  α'V𝒱 = αV𝒱  α'C𝒱 = []))"

lemma BSP_valid_BSD: "BSP_valid BSD"
proof -
  {  
    fix 𝒱::"('e V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr"
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "BSD 𝒱 ?Tr'"
      unfolding BSD_def by auto
    ultimately
    have  " Tr'. Tr'  Tr   BSD 𝒱 Tr'"
      by auto
  }
  thus ?thesis
    unfolding BSP_valid_def by auto
qed

(* Backwards Strict Insertion of Confidential Events (BSI) *)
definition BSI :: "'e BSP"
where
"BSI 𝒱 Tr  
  α β. cC𝒱. ((β @ α)  Tr  αC𝒱 = []) 
     (α'. ((β @ [c] @ α')  Tr  α'V𝒱 = αV𝒱  α'C𝒱 = []))"

lemma BSP_valid_BSI: "BSP_valid BSI"
proof -
  {  
    fix 𝒱::"('e V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr"
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "BSI 𝒱 ?Tr'" using ‹isViewOn 𝒱 E
      unfolding isViewOn_def BSI_def by auto
    ultimately
    have  " Tr'. Tr'  Tr   BSI 𝒱 Tr'"
      by auto
  }
  thus ?thesis
    unfolding BSP_valid_def by auto
qed

(* Backwards Strict Insertion of Admissible Confidential Events (BSIA) *)
definition BSIA :: "'e Rho  'e BSP"
where 
"BSIA ρ 𝒱 Tr  
  α β. cC𝒱. ((β @ α)  Tr  αC𝒱 = []  (Adm 𝒱 ρ Tr β c)) 
     (α'. ((β @ [c] @ α')  Tr  α'V𝒱 = αV𝒱  α'C𝒱 = []))"

lemma BSP_valid_BSIA: "BSP_valid (BSIA ρ) "
proof -
  {  
    fix 𝒱 :: "('a V_rec)"
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr"
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "BSIA ρ 𝒱 ?Tr'" using ‹isViewOn 𝒱 E
      unfolding isViewOn_def BSIA_def by auto
    ultimately
    have  " Tr'. Tr'  Tr   BSIA ρ 𝒱 Tr'"
      by auto
  }
  thus ?thesis
    unfolding BSP_valid_def by auto
qed

(* Forward Correctable BSPs *)
record 'e Gamma =
  Nabla :: "'e set"
  Delta :: "'e set"
  Upsilon :: "'e set"

(* syntax abbreviations for Gamma *)
abbreviation GammaNabla :: "'e Gamma  'e set"
("∇⇘_" [100] 1000)
where
"∇Γ  (Nabla Γ)"

abbreviation GammaDelta :: "'e Gamma  'e set"
("Δ⇘_" [100] 1000)
where
Γ  (Delta Γ)"

abbreviation GammaUpsilon :: "'e Gamma  'e set"
("Υ⇘_" [100] 1000)
where
Γ  (Upsilon Γ)"


(* Forward Correctable Deletion of Confidential Events (FCD) *)
definition FCD :: "'e Gamma  'e BSP"
where
"FCD Γ 𝒱 Tr  
  α β. c(C𝒱  ΥΓ). v(V𝒱 Γ). 
    ((β @ [c,v] @ α)  Tr  α  C𝒱 = []) 
       (α'. δ'. (set δ')  (N𝒱  ΔΓ) 
                       ((β @ δ' @ [v] @ α')  Tr  
                       α'V𝒱 = αV𝒱  α'C𝒱 = []))"

lemma BSP_valid_FCD: "BSP_valid (FCD Γ)"
proof -
  {  
    fix 𝒱::"('a V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr" 
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "FCD Γ 𝒱 ?Tr'"
      proof -
        {
          fix α β c v
          assume  "c  C𝒱  ΥΓ"
             and  "v V𝒱 Γ"
             and  "β @ [c ,v] @ α  ?Tr'"
             and  "α  C𝒱 = []"
          let ?α'="α" and ?δ'="[]"  
          from β @ [c ,v] @ α  ?Tr' have "β @ ?δ' @ [v] @ ?α'  ?Tr'"
            by auto 
          hence  "(set ?δ')  (N𝒱  ΔΓ)  ((β @ ?δ' @ [v] @ ?α')  ?Tr'  
                       ?α'  V𝒱 = α  V𝒱  ?α'  C𝒱 = [])"   
            using ‹isViewOn 𝒱 E α  C𝒱 = [] 
            unfolding isViewOn_def α  C𝒱 = [] by auto
          hence "α'. δ'. (set δ')  (N𝒱  ΔΓ)  ((β @ δ' @ [v] @ α')  ?Tr'  
             α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])"
            by blast
        }
        thus ?thesis
          unfolding FCD_def by auto 
      qed
    ultimately
    have  " Tr'. Tr'  Tr   FCD Γ 𝒱 Tr'"
      by auto
  }
  thus ?thesis
    unfolding BSP_valid_def by auto
qed

(* Forward Correctable Insertion of Confidential Events (FCI) *)
definition FCI :: "'e Gamma  'e BSP"
where
"FCI Γ 𝒱 Tr  
  α β. c(C𝒱  ΥΓ). v(V𝒱 Γ). 
    ((β @ [v] @ α)  Tr  αC𝒱 = []) 
       (α'. δ'. (set δ')  (N𝒱  ΔΓ) 
                       ((β @ [c] @ δ' @ [v] @ α')  Tr  
                       α'V𝒱 = αV𝒱  α'C𝒱 = []))"

lemma BSP_valid_FCI: "BSP_valid (FCI Γ)"
proof -
  {  
    fix 𝒱::"('a V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr" 
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "FCI Γ 𝒱 ?Tr'"
      proof -
        {
          fix α β c v
          assume  "c  C𝒱  ΥΓ"
             and  "v V𝒱 Γ"
             and  "β @ [v] @ α  ?Tr'"
             and  "α  C𝒱 = []"
          let ?α'="α" and ?δ'="[]"  
          from c  C𝒱  ΥΓ have" c  E" 
            using ‹isViewOn 𝒱 E
            unfolding isViewOn_def by auto
          with  β @ [v] @ α  ?Tr' have "β @ [c] @ ?δ' @ [v] @ ?α'  ?Tr'" 
            by auto 
          hence  "(set ?δ')  (N𝒱  ΔΓ)  ((β @ [c] @ ?δ' @ [v] @ ?α')  ?Tr'  
                       ?α'  V𝒱 = α  V𝒱  ?α'  C𝒱 = [])"   
           using ‹isViewOn 𝒱 E α  C𝒱 = []  unfolding isViewOn_def α  C𝒱 = [] by auto
         hence 
           "α'. δ'. (set δ')  (N𝒱  ΔΓ)  ((β @ [c] @ δ' @ [v] @ α')  ?Tr'  
             α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])" 
            by blast
        }
        thus ?thesis
          unfolding FCI_def by auto 
      qed
    ultimately
    have  " Tr'. Tr'  Tr   FCI Γ 𝒱 Tr'" 
      by auto
  }
  thus ?thesis 
    unfolding BSP_valid_def by auto
qed

(* Forward correctable Insertion of Admissible Confidential Events (FCIA) *)
definition FCIA :: "'e Rho  'e Gamma  'e BSP"
where
"FCIA ρ Γ 𝒱 Tr  
  α β. c(C𝒱  ΥΓ). v(V𝒱 Γ).
    ((β @ [v] @ α)  Tr  αC𝒱 = []  (Adm 𝒱 ρ Tr β c)) 
       (α'. δ'. (set δ')  (N𝒱  ΔΓ) 
                       ((β @ [c] @ δ' @ [v] @ α')  Tr  
                       α'V𝒱 = αV𝒱  α'C𝒱 = []))"

lemma BSP_valid_FCIA: "BSP_valid (FCIA ρ Γ) "
proof -
  {  
    fix 𝒱 :: "('a V_rec)"
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr"
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "FCIA ρ Γ 𝒱 ?Tr'"
    proof -
        {
          fix α β c v
          assume  "c  C𝒱  ΥΓ"
             and  "v V𝒱 Γ"
             and  "β @ [v] @ α  ?Tr'"
             and  "α  C𝒱 = []"
          let ?α'="α" and ?δ'="[]"  
          from c  C𝒱  ΥΓ have" c  E" 
            using ‹isViewOn 𝒱 E unfolding isViewOn_def by auto
          with  β @ [v] @ α  ?Tr' have "β @ [c] @ ?δ' @ [v] @ ?α'  ?Tr'"
            by auto 
          hence  "(set ?δ')  (N𝒱  ΔΓ)  ((β @ [c] @ ?δ' @ [v] @ ?α')  ?Tr'  
                       ?α'  V𝒱 = α  V𝒱  ?α'  C𝒱 = [])"   
            using ‹isViewOn 𝒱 E α  C𝒱 = []  
            unfolding isViewOn_def α  C𝒱 = [] by auto
          hence 
            "α'. δ'. (set δ')  (N𝒱  ΔΓ)  ((β @ [c] @ δ' @ [v] @ α')  ?Tr'  
             α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])" 
            by blast
        }
        thus ?thesis
          unfolding FCIA_def by auto 
      qed
    ultimately
    have  " Tr'. Tr'  Tr   FCIA ρ Γ 𝒱 Tr'"
      by auto
  }
  thus ?thesis
    unfolding BSP_valid_def by auto
qed

(* Strict Removal of Confidential Events (SR) *)
definition SR :: "'e BSP"
where
"SR 𝒱 Tr  τTr. τ  (V𝒱  N𝒱)  Tr"

lemma "BSP_valid SR"
proof -
  {  
    fix 𝒱::"('e V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. τ  Tr. t=τ(V𝒱  N𝒱)}  Tr"
    have "?Tr' Tr" 
      by blast
    moreover
    have "SR 𝒱 ?Tr'" unfolding SR_def 
      proof
        fix τ
        assume "τ  ?Tr'"
        {
          from τ  ?Tr' have "(tTr. τ = t  (V𝒱  N𝒱))  τ  Tr"
            by auto
          hence "τ  (V𝒱  N𝒱)  ?Tr'" 
            proof 
              assume "tTr. τ = t (V𝒱  N𝒱)" 
              hence "tTr. τ  (V𝒱  N𝒱)= t (V𝒱  N𝒱)" 
                using projection_idempotent by metis
              thus ?thesis 
                by auto
            next
              assume "τ  Tr" 
              thus ?thesis 
                by auto
            qed  
        }  
        thus "τ  (V𝒱  N𝒱)  ?Tr'" 
          by auto
      qed
    ultimately
    have " Tr'. Tr'  Tr   SR 𝒱 Tr'" 
      by auto
  }
  thus ?thesis 
    unfolding BSP_valid_def by auto
qed

(* Strict Deletion of Confidential Events (SD) *)
definition SD :: "'e BSP"
where
"SD 𝒱 Tr  
  α β. cC𝒱. ((β @ [c] @ α)  Tr  αC𝒱 = [])  β @ α  Tr"

lemma "BSP_valid SD"
proof -
  {  
    fix 𝒱::"('e V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr" by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "SD 𝒱 ?Tr'" unfolding SD_def by auto
    ultimately
    have  " Tr'. Tr'  Tr   SD 𝒱 Tr'" by auto
  }
  thus ?thesis unfolding BSP_valid_def by auto
qed
 
(* Strict Insertion of Confidential Events (SI) *)
definition SI :: "'e BSP"
where
"SI 𝒱 Tr  
  α β. cC𝒱. ((β @ α)  Tr  α  C𝒱 = [])  β @ [c] @ α  Tr"

lemma "BSP_valid SI"
proof -
  {  
    fix 𝒱::"('a V_rec)" 
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr"
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "SI 𝒱 ?Tr'" 
      using ‹isViewOn 𝒱 E 
      unfolding isViewOn_def SI_def by auto
    ultimately
    have  " Tr'. Tr'  Tr   SI 𝒱 Tr'" 
      by auto
  }
  thus ?thesis 
    unfolding BSP_valid_def by auto
qed

(* Strict Insertion of Admissible Confidential Events (SIA) *)
definition SIA :: "'e Rho  'e BSP"
where
"SIA ρ 𝒱 Tr  
  α β. cC𝒱. ((β @ α)  Tr  α  C𝒱 = []  (Adm 𝒱 ρ Tr β c)) 
     (β @ [c] @ α)  Tr" 

lemma "BSP_valid (SIA ρ) "
proof -
  {  
    fix 𝒱 :: "('a V_rec)"
    fix Tr E
    assume "isViewOn 𝒱 E"
    and "areTracesOver Tr E"     
    let ?Tr'="{t. (set t)  E}"
    have "?Tr' Tr" 
      by (meson Ball_Collect ‹areTracesOver Tr E areTracesOver_def)
    moreover
    have "SIA ρ 𝒱 ?Tr'" 
      using ‹isViewOn 𝒱 E 
      unfolding isViewOn_def SIA_def by auto
    ultimately
    have  " Tr'. Tr'  Tr   SIA ρ 𝒱 Tr'" 
      by auto
  }
  thus ?thesis 
    unfolding BSP_valid_def by auto
qed

end

Theory InformationFlowProperties

theory InformationFlowProperties
imports BasicSecurityPredicates
begin

(* Security Predicates are sets of basic security predicates *)
type_synonym 'e SP = "('e BSP) set"

(* structurally, information flow properties consist of a set of views 
 and a security predicate. *)
type_synonym 'e IFP_type = "('e V_rec set) × 'e SP"

(* side condition for information flow properties *)
definition IFP_valid :: "'e set  'e IFP_type  bool"
where
"IFP_valid E ifp   
  𝒱  (fst ifp). isViewOn 𝒱 E  
                     (BSP  (snd ifp). BSP_valid BSP)"

(* An information flow property is an instance of IFP_type that 
 satisfies IFP_valid. *)
definition IFPIsSatisfied :: "'e IFP_type  ('e list) set   bool"
where 
"IFPIsSatisfied ifp Tr  
   𝒱(fst ifp).  BSP(snd ifp). BSP 𝒱 Tr"

end

Theory BSPTaxonomy

theory BSPTaxonomy
imports "../../SystemSpecification/EventSystems"
  "../../SecuritySpecification/BasicSecurityPredicates"
begin

locale BSPTaxonomyDifferentCorrections =
fixes ES :: "'e ES_rec"
and 𝒱 :: "'e V_rec"

assumes validES: "ES_valid ES"
and VIsViewOnE: "isViewOn 𝒱 EES"

locale BSPTaxonomyDifferentViews =
fixes ES :: "'e ES_rec"
and 𝒱1 :: "'e V_rec"
and 𝒱2 :: "'e V_rec"

assumes validES: "ES_valid ES"
and 𝒱1IsViewOnE: "isViewOn 𝒱1 EES" 
and 𝒱2IsViewOnE: "isViewOn 𝒱2 EES"

locale BSPTaxonomyDifferentViewsFirstDim= BSPTaxonomyDifferentViews +
assumes V2_subset_V1: "V𝒱2  V𝒱1"  
and     N2_supset_N1: "N𝒱2  N𝒱1"
and     C2_subset_C1: "C𝒱2  C𝒱1"

sublocale  BSPTaxonomyDifferentViewsFirstDim  BSPTaxonomyDifferentViews
by (unfold_locales)

locale BSPTaxonomyDifferentViewsSecondDim= BSPTaxonomyDifferentViews +
assumes V2_subset_V1: "V𝒱2  V𝒱1"  
and     N2_supset_N1: "N𝒱2  N𝒱1"
and     C2_equals_C1: "C𝒱2 = C𝒱1"

sublocale  BSPTaxonomyDifferentViewsSecondDim  BSPTaxonomyDifferentViews
by (unfold_locales)

(* body of BSPTaxonomy *)
context BSPTaxonomyDifferentCorrections
begin

(*lemma taken from lemma 3.5.1 from Heiko Mantel's dissertation*)
lemma SR_implies_R: 
"SR 𝒱 TrES  R 𝒱 TrES"
proof -
  assume SR: "SR 𝒱 TrES"
  {
    fix τ
    assume "τ  TrES"
    with SR  have "τ  (V𝒱  N𝒱)  TrES" 
      unfolding SR_def by auto 
    hence " τ'. τ'  TrES  τ'  V𝒱 = τ  V𝒱  τ'  C𝒱 = []"
    proof -
      assume tau_V_N_is_trace: "τ  (V𝒱  N𝒱)  TrES"
      show " τ'. τ'  TrES  τ'  V𝒱 = τ  V𝒱  τ'  C𝒱 = []"
      proof
        let  ?τ'= "τ  (V𝒱  N𝒱)"
        have "τ  (V𝒱  N𝒱)  V𝒱 = τ  V𝒱" 
          by (simp add: projection_subset_elim) 
        moreover
        from  VIsViewOnE have "VC_disjoint 𝒱  NC_disjoint 𝒱" 
          unfolding isViewOn_def V_valid_def
          by auto
        then have "(V𝒱  N𝒱)  C𝒱 = {}" 
          by (simp add: NC_disjoint_def VC_disjoint_def inf_sup_distrib2) 
        then have "?τ'  C𝒱 = []" 
          by (simp add: disjoint_projection)
        ultimately
        show "?τ'  TrES  ?τ'  V𝒱 = τ  V𝒱  ?τ'  C𝒱 = []" 
          using  tau_V_N_is_trace  by auto 
      qed  
    qed
  }
  thus ?thesis
    unfolding SR_def R_def by auto
qed

(* lemma taken from lemma 3.5.1 from Heiko Mantel's dissertation *)
lemma SD_implies_BSD :
"(SD 𝒱 TrES)  BSD 𝒱 TrES "
proof -
  assume SD:  "SD 𝒱 TrES"
  { 
    fix α β c 
    assume "c  C𝒱"
      and  "β @ c # α  TrES" 
      and  alpha_C_empty: "α  C𝒱 = []" 
    with SD have "β @ α  TrES"
      unfolding SD_def by auto
    hence "α'. β @ α'  TrES  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []"
      using alpha_C_empty  
      by auto
   }
   thus ?thesis
     unfolding SD_def BSD_def by auto
qed

(* lemma taken from lemma 3.5.1 from Heiko Mantel's dissertation *)
lemma BSD_implies_D: 
"BSD 𝒱 TrES  D 𝒱 TrES"
proof - 
  assume BSD: "BSD 𝒱 TrES"
  
  {
    fix α β c
    assume "α  C𝒱 = []"
      and "c  C𝒱"
      and "β @ [c] @ α  TrES"
    with BSD obtain α' 
      where "β @ α'  TrES"
      and "α'  V𝒱 = α  V 𝒱"
      and  "α'  C𝒱 = []"
      by (simp add: BSD_def, auto)
    hence "(α' β'.
      (β' @ α'  TrES  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []) 
      β'  (V𝒱  C𝒱) = β  (V𝒱  C𝒱))"
      by auto
  }
  thus ?thesis
    unfolding BSD_def D_def
    by auto
qed

(* lemma taken from lemma 3.5.1 from Heiko Mantel's dissertation *)
lemma SD_implies_SR: 
"SD 𝒱 TrES  SR 𝒱 TrES"
unfolding SR_def
proof
  fix τ 

  assume SD: "SD 𝒱 TrES"
  assume τ_trace: "τ  TrES"
  
  {
    fix  n 

      (* show via induction over length (τ ↿ C𝒱) that SR holds *)
    have SR_via_length: "  τ  TrES; n = length (τ  C𝒱)  
       τ'  TrES. τ'  C𝒱 = []  τ'  (V𝒱  N𝒱) = τ  (V𝒱  N𝒱)"
    proof (induct n arbitrary: τ)
      case 0 
      note τ_in_Tr = τ  TrES
        and 0 = length (τ  C𝒱)
      hence "τ  C𝒱 = []" 
        by simp
      with τ_in_Tr show ?case 
        by auto
    next
      case (Suc n)
      from projection_split_last[OF Suc(3)] obtain β c α
        where c_in_C: "c  C𝒱"
        and τ_is_βcα: "τ = β @ [c] @ α"
        and α_no_c: "α  C𝒱 = []"
        and βα_contains_n_cs: "n = length ((β @ α)  C𝒱)"
      by auto
      with Suc(2) have βcα_in_Tr: "β @ [c] @ α  TrES"
        by auto
      
      with SD c_in_C βcα_in_Tr α_no_c obtain β' α' 
        where β'α'_in_Tr: "(β' @ α')  TrES" 
        and α'_V_is_α_V: "α'  (V𝒱  N𝒱) = α  (V𝒱  N𝒱)"
        and α'_no_c: "α'  C𝒱 = []" 
        and β'_VC_is_β_VC: "β'  (V𝒱  N𝒱  C𝒱) = β  (V𝒱  N𝒱  C𝒱)"
        unfolding SD_def
        by blast
       
      have "(β' @ α')  (V𝒱  N𝒱) = τ  (V𝒱  N𝒱)"
      proof - 
        from β'_VC_is_β_VC have  "β'  (V𝒱  N𝒱) = β  (V𝒱  N𝒱)"
          by (rule projection_subset_eq_from_superset_eq)
        with α'_V_is_α_V have "(β' @ α')  (V𝒱  N𝒱) = (β @ α)  (V𝒱  N𝒱)"
          by (simp add: projection_def)
        moreover
        with  VIsViewOnE c_in_C have "c  (V𝒱  N𝒱)"
          by (simp add: isViewOn_def V_valid_def VC_disjoint_def NC_disjoint_def, auto)
        hence "(β @ α)  (V𝒱  N𝒱) = (β @ [c] @ α)  (V𝒱  N𝒱)"
          by (simp add: projection_def)
        moreover note τ_is_βcα
        ultimately show ?thesis
          by auto
      qed
      moreover 
      have "n = length ((β' @ α')  C𝒱)"
      proof -
        have  "β'  C𝒱 = β  C𝒱"
        proof -
          have "V𝒱  N𝒱  C𝒱 = C𝒱  (V𝒱  N𝒱)"
            by auto
          with β'_VC_is_β_VC have "β'  (C𝒱  (V𝒱  N𝒱)) = β  (C𝒱  (V𝒱  N𝒱))"
            by auto
          thus ?thesis
            by (rule projection_subset_eq_from_superset_eq)
        qed
        with α'_no_c α_no_c have "(β' @ α')  C𝒱 = (β @ α)  C𝒱"
          by (simp add: projection_def)
        with βα_contains_n_cs show ?thesis
          by auto
      qed
      with Suc.hyps β'α'_in_Tr obtain τ' 
        where  "τ'  TrES" 
        and "τ'  C𝒱 = []" 
        and "τ'  (V𝒱  N𝒱) = (β' @ α')  (V𝒱  N𝒱)"
        by auto
      ultimately show ?case
        by auto
    qed 
  }
  
  hence "τ  TrES  τ'. τ'TrES  τ'  C𝒱 = []  τ'  (V𝒱  N𝒱) = τ  (V𝒱  N𝒱)" 
    by auto

  from this τ_trace obtain τ' where
        τ'_trace : "τ'TrES"
    and τ'_no_C  : "τ'  C𝒱 = []"
    and τ'_τ_rel : "τ'  (V𝒱  N𝒱) = τ  (V𝒱  N𝒱)" 
  by auto

  from τ'_no_C have "τ'  (V𝒱  N𝒱  C𝒱) = τ'  (V𝒱  N𝒱)" 
    by (auto simp add: projection_on_union)

  with  VIsViewOnE have τ'_E_eq_VN: "τ'  EES = τ'  (V𝒱  N𝒱)" 
    by (auto simp add: isViewOn_def)

  from validES τ'_trace have "(set τ')  EES" 
    by (auto simp add: ES_valid_def traces_contain_events_def)
  hence "τ'  EES = τ'" by (simp add: list_subset_iff_projection_neutral)
  with τ'_E_eq_VN have "τ' = τ'  (V𝒱  N𝒱)" by auto
  with τ'_τ_rel have "τ' = τ  (V𝒱  N𝒱)" by auto
  with τ'_trace show "τ  (V𝒱  N𝒱)  TrES" by auto
qed

(* lemma taken from lemma 3.5.1 from Heiko Mantel's dissertation *)
lemma D_implies_R: 
"D 𝒱 TrES  R 𝒱 TrES"
proof -
  assume D: "D 𝒱 TrES"  
  {
    fix τ n 

      (* show via induction over length (τ ↿ C𝒱) that R holds *)
    have R_via_length: "  τ  TrES; n = length (τ  C𝒱) 
                           τ'  TrES. τ'  C𝒱 = []  τ'  V𝒱 = τ  V𝒱"
    proof (induct n arbitrary: τ)
      case 0 
      note τ_in_Tr = τ  TrES
        and 0 = length (τ  C𝒱)
      hence "τ  C𝒱 = []" 
        by simp
      with τ_in_Tr show ?case 
        by auto
    next
      case (Suc n)
      from projection_split_last[OF Suc(3)] obtain β c α
        where c_in_C: "c  C𝒱"
        and τ_is_βcα: "τ = β @ [c] @ α"
        and α_no_c: "α  C𝒱 = []"
        and βα_contains_n_cs: "n = length ((β @ α)  C𝒱)"
      by auto
      with Suc(2) have βcα_in_Tr: "β @ [c] @ α  TrES"
        by auto
      
      with D c_in_C βcα_in_Tr α_no_c obtain β' α' 
        where β'α'_in_Tr: "(β' @ α')  TrES" 
        and α'_V_is_α_V: "α'  V𝒱 = α  V𝒱"
        and α'_no_c: "α'  C𝒱 = []" 
        and β'_VC_is_β_VC: "β'  (V𝒱  C𝒱) = β  (V𝒱  C𝒱)"
        unfolding D_def 
        by blast

      have "(β' @ α')  V𝒱 = τ  V𝒱"
      proof - 
        from β'_VC_is_β_VC have  "β'  V𝒱 = β  V𝒱"
          by (rule projection_subset_eq_from_superset_eq)
        with α'_V_is_α_V have "(β' @ α')  V𝒱 = (β @ α)  V𝒱"
          by (simp add: projection_def)
        moreover
        with  VIsViewOnE c_in_C have "c  V𝒱"
          by (simp add: isViewOn_def V_valid_def VC_disjoint_def, auto)
        hence "(β @ α)  V𝒱 = (β @ [c] @ α)  V𝒱"
          by (simp add: projection_def)
        moreover note τ_is_βcα
        ultimately show ?thesis
          by auto
      qed
      moreover 
      have "n = length ((β' @ α')  C𝒱)"
      proof -
        have  "β'  C𝒱 = β  C𝒱"
        proof -
          have "V𝒱  C𝒱 = C𝒱  V𝒱"
            by auto
          with β'_VC_is_β_VC have "β'  (C𝒱  V𝒱) = β  (C𝒱  V𝒱)"
            by auto
          thus ?thesis
            by (rule projection_subset_eq_from_superset_eq)
        qed
        with α'_no_c α_no_c have "(β' @ α')  C𝒱 = (β @ α)  C𝒱"
          by (simp add: projection_def)
        with βα_contains_n_cs show ?thesis
          by auto
      qed
      with Suc.hyps β'α'_in_Tr obtain τ' 
        where  "τ'  TrES" 
        and "τ'  C𝒱 = []" 
        and "τ'  V𝒱 = (β' @ α')  V𝒱"
        by auto
      ultimately show ?case
        by auto
    qed 
  }
  thus ?thesis
    by (simp add: R_def)
qed

(* Theorem 3.5.6.1 from Heiko Mantel's dissertation *)
lemma SR_implies_R_for_modified_view :
"SR 𝒱 TrES; 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱   R 𝒱' TrES" 
proof -
  assume "SR 𝒱 TrES"
     and "𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 "
   {
     from 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  VIsViewOnE 
     have V'IsViewOnE: "isViewOn 𝒱' EES " 
       unfolding isViewOn_def V_valid_def VC_disjoint_def NC_disjoint_def VN_disjoint_def by auto
    fix τ
    assume "τ  TrES"
    with ‹SR 𝒱 TrES have "τ  (V𝒱  N𝒱)  TrES"
      unfolding SR_def by auto
    
    let ?τ'="τ V𝒱'"
    
    from τ  (V𝒱  N𝒱)  TrES have "?τ'  TrES" 
      using 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  by simp
    moreover   
    from V'IsViewOnE have "?τ'C𝒱'=[]"
      using disjoint_projection  
      unfolding isViewOn_def V_valid_def VC_disjoint_def by auto
    moreover  
    have "?τ'V𝒱' = τV𝒱'"
      by (simp add: projection_subset_elim)
    ultimately
    have "τ'TrES. τ'  C𝒱' = []  τ'  V𝒱' = τ  V𝒱'"
      by auto
   }
  with ‹SR 𝒱 TrES show ?thesis 
    unfolding R_def using 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  by auto 
qed   

lemma R_implies_SR_for_modified_view : 
"R 𝒱' TrES; 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱   SR 𝒱 TrES"
proof -
  assume "R 𝒱' TrES"
     and "𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 "
  {
    fix τ
    assume "τ  TrES"
    from ‹R 𝒱' TrES τ  TrES  obtain τ' where "τ'  TrES"
                                        and "τ'  C𝒱' = []" 
                                        and "τ'  V𝒱' = τ  V𝒱'"
                                        unfolding R_def by auto
    from VIsViewOnE 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱   have "isViewOn  𝒱' EES" 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def VC_disjoint_def NC_disjoint_def                                   
      by auto

    from τ'  V𝒱' = τ  V𝒱'  𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  
    have "τ'  (V𝒱'  N𝒱') = τ  (V𝒱'  N𝒱')" 
      by simp
    
    from τ'  C𝒱' = [] have "τ' =τ'  (V𝒱'  N𝒱')"
      using validES τ'  TrES ‹isViewOn 𝒱' EES 
      unfolding projection_def ES_valid_def isViewOn_def traces_contain_events_def
      by (metis UnE filter_True filter_empty_conv)
    hence  "τ' =τ  (V𝒱'  N𝒱')" 
      using τ'  (V𝒱'  N𝒱') = τ  (V𝒱'  N𝒱')
      by simp                 
    with τ'  TrES have "τ  (V𝒱'  N𝒱')  TrES" 
      by auto
  } 
  thus ?thesis 
    unfolding SR_def using 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 
    by simp
qed

(* Theorem 3.5.6.2 from Heiko Mantel's dissertation *)
lemma SD_implies_BSD_for_modified_view :
"SD 𝒱 TrES; 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱   BSD 𝒱' TrES" 
proof -
  assume "SD 𝒱 TrES"
     and "𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 "
   {
    fix α β c
    assume "c  C𝒱'"
       and "β @ [c] @ α  TrES"
       and "αC𝒱' = []"
    
    from c  C𝒱'  𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 
    have "c  C𝒱" 
      by auto     
    from αC𝒱' = [] 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  
    have "αC𝒱 = []" 
      by auto

    from c  C𝒱 β @ [c] @ α  TrES αC𝒱 = [] 
    have "β @ α  TrES" using ‹SD 𝒱 TrES
      unfolding SD_def by auto
    hence  "α'. β @ α'  TrES   α'  V𝒱' = α  V𝒱'   α'  C𝒱' = [] " 
      using α  C𝒱' = [] by blast
   }
  with ‹SD 𝒱 TrES show ?thesis 
    unfolding BSD_def using 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  by auto 
qed   

lemma BSD_implies_SD_for_modified_view : 
"BSD 𝒱' TrES; 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱   SD 𝒱 TrES"
  unfolding SD_def
  proof(clarsimp)
  fix α β c
  assume BSD_view' : "BSD V = V𝒱  N𝒱 , N = {} , C = C𝒱 TrES"
  assume alpha_no_C_view : "α  C𝒱 = []"
  assume c_C_view : "c  C𝒱"
  assume beta_c_alpha_is_trace : "β @ c # α  TrES"
  
  from BSD_view' alpha_no_C_view c_C_view beta_c_alpha_is_trace 
  obtain α' 
    where beta_alpha'_is_trace: "β @ α'(TrES)" 
      and alpha_alpha': "α'  (V𝒱  N𝒱) = α  (V𝒱  N𝒱)"
      and alpha'_no_C_view : "α'  C𝒱 = []"
    by (auto simp add: BSD_def)

  from beta_c_alpha_is_trace validES
  have alpha_consists_of_events: "set α  EES" 
      by (auto simp add: ES_valid_def traces_contain_events_def)

  from alpha_no_C_view have "α  (V𝒱  N𝒱  C𝒱) = α  (V𝒱  N𝒱)"
    by (rule projection_on_union)
  with VIsViewOnE  have alpha_on_ES : "α  EES = α  (V𝒱  N𝒱)" 
    unfolding isViewOn_def by simp

  from alpha_consists_of_events VIsViewOnE have "α  EES = α"
    by (simp add: list_subset_iff_projection_neutral)
  
  with alpha_on_ES have α_eq: "α  (V𝒱  N𝒱) = α" by auto

  from beta_alpha'_is_trace validES
  have alpha'_consists_of_events: "set α'  EES" 
    by (auto simp add: ES_valid_def traces_contain_events_def)

  from alpha'_no_C_view have "α'  (V𝒱  N𝒱  C𝒱) = α'  (V𝒱  N𝒱)"
    by (rule projection_on_union)
  with VIsViewOnE have alpha'_on_ES : "α'  EES = α'  (V𝒱  N𝒱)"
    unfolding isViewOn_def by (simp)

  from alpha'_consists_of_events VIsViewOnE have "α'  EES = α'"
    by (simp add: list_subset_iff_projection_neutral)
  
  with alpha'_on_ES have α'_eq: "α'  (V𝒱  N𝒱) = α'" by auto


  from alpha_alpha' α_eq α'_eq have "α = α'" by auto
    
  with beta_alpha'_is_trace show "β @ α  TrES" by auto
qed


(* lemma taken from lemma 3.5.4 from Heiko Mantel's dissertation*)
lemma SD_implies_FCD: 
"(SD 𝒱 TrES)  FCD Γ 𝒱 TrES"
proof -    
   assume SD: "SD 𝒱 TrES"
    { 
    fix α β c v
    assume "c  C𝒱   ΥΓ"
      and  "v  V𝒱  Γ"
      and alpha_C_empty: "α  C𝒱 = []"
      and  "β @ [c, v] @ α  TrES"
    moreover
    with VIsViewOnE  have "(v # α)  C𝒱 = []" 
      unfolding isViewOn_def V_valid_def VC_disjoint_def projection_def by auto
    ultimately
    have "β @ (v # α)  TrES" 
      using SD unfolding SD_def by auto
    with alpha_C_empty  
    have "α'. δ'. (set δ')  (N𝒱  ΔΓ)  ((β @ δ' @ [v] @ α')   TrES  
             α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])" 
      by (metis append.simps(1) append.simps(2) bot_least list.set(1))
  }    
  thus ?thesis 
    unfolding SD_def FCD_def by auto
qed



(* lemma taken from lemma 3.5.9 from Heiko Mantel's dissertation *)
lemma SI_implies_BSI :
"(SI 𝒱 TrES)  BSI 𝒱 TrES "
proof -
  assume SI: "SI 𝒱 TrES"
  { 
    fix α β c 
    assume "c  C𝒱"
      and  "β @  α  TrES" 
      and alpha_C_empty: "α  C𝒱 = []" 
    with SI have "β @ c # α  TrES" 
      unfolding SI_def by auto
    hence  "α'. β @ c # α'  TrES  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []" 
      using alpha_C_empty  by auto
  }
  thus ?thesis 
    unfolding SI_def BSI_def by auto
qed

(* lemma taken from lemma 3.5.9 from Heiko Mantel's dissertation *)
lemma BSI_implies_I: 
"(BSI 𝒱 TrES)  (I 𝒱 TrES)"
proof -
  assume BSI: "BSI 𝒱 TrES"

  {
    fix α β c
    assume "c  C𝒱"
      and "β @ α  TrES"
      and "α  C𝒱 = []"
    with BSI obtain α' 
      where "β @ [c] @ α'  TrES"
      and "α'  V𝒱 = α  V𝒱"
      and  "α'  C𝒱 = []"
      unfolding BSI_def
      by blast
    hence 
      "(α' β'. (β' @ [c] @ α'  TrES  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []) 
                  β'  (V𝒱  C𝒱) = β  (V𝒱  C𝒱))"
      by auto
  }
  thus ?thesis unfolding BSI_def I_def
    by auto
qed

(* lemma taken from lemma 3.5.9 from Heiko Mantel's dissertation *)
lemma SIA_implies_BSIA: 
"(SIA ρ 𝒱 TrES)  (BSIA ρ 𝒱 TrES)"
proof -
  assume SIA: "SIA ρ 𝒱 TrES"
  {
    fix α β c
    assume "c  C𝒱"
      and "β @ α  TrES"
      and alpha_C_empty: "α  C𝒱 = []"
      and "(Adm 𝒱 ρ TrES β c)"
    with SIA obtain "β @ c # α  TrES"
      unfolding SIA_def by auto
    hence " α'. β @ c # α'  TrES  α' V𝒱 = α  V𝒱  α'  C𝒱 = []"  
      using  alpha_C_empty  by auto
  }
  thus ?thesis
    unfolding SIA_def BSIA_def by auto
qed

(* lemma taken from lemma 3.5.9 from Heiko Mantel's dissertation *)
lemma BSIA_implies_IA: 
"(BSIA ρ 𝒱 TrES)  (IA ρ 𝒱 TrES)"
proof -
  assume BSIA: "BSIA ρ 𝒱 TrES"

  {
    fix α β c
    assume "c  C𝒱"
      and "β @ α  TrES"
      and "α  C𝒱 = []"
      and "(Adm 𝒱 ρ TrES β c)"
    with BSIA obtain α' 
      where "β @ [c] @ α'  TrES"
      and "α'  V𝒱 = α  V𝒱"
      and  "α'  C𝒱 = []"
      unfolding BSIA_def
      by blast
    hence "(α' β'.
      (β' @ [c] @ α'  TrES  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []) 
      β'  (V𝒱  C𝒱) = β  (V𝒱  C𝒱))"
      by auto
  }
  thus ?thesis 
    unfolding BSIA_def IA_def by auto
qed

(* lemma taken from lemma 3.5.9 from Heiko Mantel's dissertation *)
lemma SI_implies_SIA: 
"SI 𝒱 TrES  SIA ρ 𝒱 TrES" 
proof -
  assume SI: "SI 𝒱 TrES"
  {
    fix α β c
    assume "c  C𝒱"
      and  "β @ α  TrES"
      and  "α  C𝒱 = []"
      and  "Adm 𝒱 ρ TrES β c"
    with SI have "β @ (c # α)  TrES"
      unfolding SI_def by auto  
  }
  thus ?thesis unfolding SI_def SIA_def by auto  
qed

(* lemma taken from lemma 3.5.9 from Heiko Mantel's dissertation *)
lemma BSI_implies_BSIA: 
"BSI 𝒱 TrES  BSIA ρ 𝒱 TrES" 
proof -
  assume BSI: "BSI 𝒱 TrES"
  {
    fix α β c
    assume "c  C𝒱"
      and  "β @ α  TrES"
      and  "α  C𝒱 = []"
      and  "Adm 𝒱 ρ TrES β c"
    with BSI have " α'. β @ (c # α')  TrES  α'  V𝒱 = α  V𝒱   α'  C𝒱 = []" 
      unfolding BSI_def by auto  
  }
  thus ?thesis
    unfolding BSI_def BSIA_def by auto  
qed

(* lemma taken from lemma 3.5.9 from Heiko Mantel's dissertation *)
lemma I_implies_IA: 
"I 𝒱 TrES  IA ρ 𝒱 TrES" 
proof -
  assume I: "I 𝒱 TrES"
  {
    fix α β c
    assume "c  C𝒱"
      and  "β @ α  TrES"
      and  "α  C𝒱 = []"
      and  "Adm 𝒱 ρ TrES β c"
    with I have " α' β'. β' @ (c # α')  TrES  α'  V𝒱 = α  V𝒱  
                             α'  C𝒱 = []   β' (V𝒱  C𝒱) = β (V𝒱  C𝒱) " 
      unfolding I_def by auto  
  }
  thus ?thesis
    unfolding I_def IA_def by auto  
qed

(* Theorem 3.5.15.1 from Heiko Mantel's dissertation *)
lemma SI_implies_BSI_for_modified_view :
"SI 𝒱 TrES; 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱   BSI 𝒱' TrES" 
proof -
  assume "SI 𝒱 TrES"
     and "𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 "
   {
    fix α β c
    assume "c  C𝒱'"
       and "β  @ α  TrES"
       and "αC𝒱' = []"
    
    from c  C𝒱'  𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 
    have "c  C𝒱"
      by auto     
    from αC𝒱' = [] 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  
    have "αC𝒱 = []"
      by auto

    from c  C𝒱 β  @ α  TrES αC𝒱 = [] 
    have "β @ [c] @  α  TrES" 
      using ‹SI 𝒱 TrES  unfolding SI_def by auto
    hence  "α'. β @ [c] @  α'  TrES   α'  V𝒱' = α  V𝒱'   α'  C𝒱' = [] " 
      using α  C𝒱' = [] 
      by blast
   }
  with ‹SI 𝒱 TrES show ?thesis 
    unfolding BSI_def using 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  by auto 
qed 

lemma BSI_implies_SI_for_modified_view : 
"BSI 𝒱' TrES; 𝒱' =  V = V𝒱  N𝒱 , N = {} , C = C𝒱   SI 𝒱 TrES"
  unfolding SI_def
  proof (clarsimp)
  fix α β c
  assume BSI_view' : "BSI V = V𝒱  N𝒱, N = {}, C = C𝒱 TrES"
  assume alpha_no_C_view : "α  C𝒱 = []"
  assume c_C_view : "c  C𝒱"
  assume beta_alpha_is_trace : "β @ α  TrES"

  from BSI_view' have "cC𝒱. β @ α  TrES  α  C𝒱 = [] 
     (α'. β @ [c] @ α'  TrES  α'  (V𝒱  N𝒱) = α  (V𝒱  N𝒱)  α'  C𝒱 = [])" 
    by (auto simp add: BSI_def)

  with beta_alpha_is_trace alpha_no_C_view have "cC𝒱.
        (α'. β @ [c] @ α'  TrES  α'  (V𝒱  N𝒱) = α  (V𝒱  N𝒱)  α'  C𝒱 = [])" 
    by auto

  with this BSI_view' c_C_view obtain α'
    where beta_c_alpha'_is_trace: "β @ [c] @ α'  TrES" 
      and alpha_alpha': "α'  (V𝒱  N𝒱) = α  (V𝒱  N𝒱)"
      and alpha'_no_C_view : "α'  C𝒱 = []"
    by auto

  from beta_alpha_is_trace validES
  have alpha_consists_of_events: "set α  EES" 
    by (auto simp add: ES_valid_def traces_contain_events_def)

  from alpha_no_C_view have "α  (V𝒱  N𝒱  C𝒱) = α  (V𝒱  N𝒱)"
    by (rule projection_on_union)
  with VIsViewOnE have alpha_on_ES : "α  EES = α  (V𝒱  N𝒱)" 
    unfolding isViewOn_def by (simp)

  from alpha_consists_of_events VIsViewOnE have "α  EES = α"
    by (simp add: list_subset_iff_projection_neutral)
  
  with alpha_on_ES have α_eq: "α  (V𝒱  N𝒱) = α" by auto
  
  from beta_c_alpha'_is_trace validES 
  have alpha'_consists_of_events: "set α'  EES" 
    by (auto simp add: ES_valid_def traces_contain_events_def)

  from alpha'_no_C_view have "α'  (V𝒱  N𝒱  C𝒱) = α'  (V𝒱  N𝒱)"
    by (rule projection_on_union)
  with VIsViewOnE have alpha'_on_ES : "α'  EES = α'  (V𝒱  N𝒱)" 
    unfolding isViewOn_def by (simp)

  from alpha'_consists_of_events VIsViewOnE have "α'  EES = α'"
    by (simp add: list_subset_iff_projection_neutral)
  
  with alpha'_on_ES have α'_eq: "α'  (V𝒱  N𝒱) = α'" by auto

  from alpha_alpha' α_eq α'_eq have "α = α'" by auto
    
  with beta_c_alpha'_is_trace show "β @ c # α  TrES" by auto
qed


(* lemma taken from Theorem 3.5.15.2 from Heiko Mantel's dissertation *)
lemma SIA_implies_BSIA_for_modified_view :
"SIA ρ 𝒱 TrES; 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  ; ρ 𝒱 = ρ' 𝒱'  BSIA ρ' 𝒱' TrES" 
proof -
  assume "SIA ρ 𝒱 TrES"
     and "𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 "
     and "ρ 𝒱 = ρ' 𝒱'"
   {
    fix α β c
    assume "c  C𝒱'"
       and "β  @ α  TrES"
       and "αC𝒱' = []"
       and "Adm 𝒱' ρ' TrES β c"
    
    from c  C𝒱'  𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 
    have "c  C𝒱"
      by auto     
    from αC𝒱' = [] 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  
    have "αC𝒱 = []"
      by auto
    from  ‹Adm 𝒱' ρ' TrES β c ρ 𝒱 = ρ' 𝒱' 
    have "Adm 𝒱 ρ TrES β c"
      by (simp add: Adm_def)

    from c  C𝒱 β  @ α  TrES αC𝒱 = [] ‹Adm 𝒱 ρ TrES β c
    have "β @ [c] @  α  TrES" 
      using ‹SIA ρ 𝒱 TrES  unfolding SIA_def by auto
    hence  "α'. β @ [c] @  α'  TrES   α'  V𝒱' = α  V𝒱'   α'  C𝒱' = [] " 
      using α  C𝒱' = [] by blast
   }
  with ‹SIA ρ 𝒱 TrES show ?thesis 
    unfolding BSIA_def using 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 
    by auto 
qed 

lemma BSIA_implies_SIA_for_modified_view : 
  "BSIA ρ' 𝒱' TrES; 𝒱' =  V = V𝒱  N𝒱 , N = {} , C = C𝒱 ; ρ 𝒱 = ρ' 𝒱'  SIA ρ 𝒱 TrES" 
proof -
  assume "BSIA ρ' 𝒱' TrES"
     and "𝒱' =  V = V𝒱  N𝒱 , N = {} , C = C𝒱 " 
     and "ρ 𝒱 = ρ' 𝒱'"
  {
    fix α β c
    assume "c  C𝒱"
       and "β  @ α  TrES"
       and "αC𝒱 = []"
       and "Adm 𝒱 ρ TrES β c"
    
    from c  C𝒱  𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱 
    have "c  C𝒱'"
      by auto     
    from αC𝒱 = [] 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  
    have "αC𝒱' = []"
      by auto
    from  ‹Adm 𝒱 ρ TrES β c ρ 𝒱 = ρ' 𝒱' 
    have "Adm 𝒱' ρ' TrES β c"
      by (simp add: Adm_def)

    from c  C𝒱' β  @ α  TrES αC𝒱' = [] ‹Adm 𝒱' ρ' TrES β c
    obtain α' where "β @ [c] @ α'  TrES"
                and " α'  V𝒱' = α  V𝒱'"
                and " α'  C𝒱' = []"
      using ‹BSIA ρ' 𝒱' TrES  unfolding BSIA_def by blast

    (*Show that α'=α*)    
    from β  @ α  TrES validES
    have alpha_consists_of_events: "set α  EES" 
      by (auto simp add: ES_valid_def traces_contain_events_def)

    from β @ [c] @ α'  TrES validES
    have alpha'_consists_of_events: "set α'  EES" 
      by (auto simp add: ES_valid_def traces_contain_events_def)  

    from α'  V𝒱' = α  V𝒱' 𝒱' =  V = V𝒱  N𝒱 , N = {} , C = C𝒱  
    have "α'(V𝒱  N𝒱)=α(V𝒱  N𝒱)" by auto
    with α'  C𝒱' = []  αC𝒱 = [] 𝒱' =  V = V𝒱  N𝒱 , N = {} , C = C𝒱 
    have "α'(V𝒱  N𝒱  C𝒱)=α(V𝒱  N𝒱  C𝒱)" 
      by (simp add: projection_on_union)
    with VIsViewOnE alpha_consists_of_events alpha'_consists_of_events
    have "α'=α" unfolding isViewOn_def 
      by (simp add: list_subset_iff_projection_neutral)

    hence  "β @ [c] @ α  TrES "
      using β @ [c] @ α'  TrES by blast
   }
  with ‹BSIA ρ' 𝒱' TrES show ?thesis 
    unfolding SIA_def using 𝒱' =  V = V𝒱  N𝒱 , N ={} , C = C𝒱  by auto   
qed    
end

(* lemma taken from lemma 3.5.11 in Heiko Mantel's dissertation *)
lemma Adm_implies_Adm_for_modified_rho: 
" Adm 𝒱2 ρ2 Tr α e;ρ2(𝒱2)  ρ1(𝒱1)  Adm 𝒱1 ρ1 Tr α e " 
proof -
  assume "Adm 𝒱2 ρ2 Tr α e"
    and  "ρ2(𝒱2)  ρ1(𝒱1)"
  then obtain γ
    where "γ @ [e]  Tr"
      and "γ  ρ2 𝒱2 = α  ρ2 𝒱2"
    unfolding Adm_def by auto
  thus "Adm 𝒱1 ρ1 Tr α e"
    unfolding Adm_def 
    using ρ1 𝒱1  ρ2 𝒱2 non_empty_projection_on_subset 
    by blast
qed

context BSPTaxonomyDifferentCorrections
begin

(* lemma taken from lemma 3.5.13 from Heiko Mantel's dissertation*)
lemma SI_implies_FCI: 
"(SI 𝒱 TrES)  FCI Γ 𝒱 TrES"
proof -    
   assume SI: "SI 𝒱 TrES"
    { 
    fix α β c v
    assume "c  C𝒱   ΥΓ"
      and  "v  V𝒱  Γ"
      and  "β @ [v] @ α  TrES"
      and alpha_C_empty: "α  C𝒱 = []"
    moreover
    with VIsViewOnE  have "(v # α)  C𝒱 = []" 
      unfolding isViewOn_def V_valid_def VC_disjoint_def projection_def by auto
    ultimately
    have "β @ [c , v] @ α  TrES" using SI unfolding SI_def by auto
    with alpha_C_empty  
    have "α'. δ'. 
              (set δ')  (N𝒱  ΔΓ)  ((β @ [c] @ δ' @ [v] @ α')   TrES 
                 α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])" 
      by (metis append.simps(1) append.simps(2) bot_least list.set(1))
  }    
  thus ?thesis 
    unfolding SI_def FCI_def by auto
qed

(* lemma taken from lemma 3.5.13 from Heiko Mantel's dissertation*)
lemma SIA_implies_FCIA: 
"(SIA ρ 𝒱 TrES)  FCIA ρ Γ 𝒱 TrES"
proof -    
   assume SIA: "SIA ρ 𝒱 TrES"
    { 
    fix α β c v
    assume "c  C𝒱   ΥΓ"
      and  "v  V𝒱  Γ"
      and  "β @ [v] @ α  TrES"
      and alpha_C_empty: "α  C𝒱 = []"
      and "Adm 𝒱 ρ TrES β c"
    moreover
    with VIsViewOnE  have "(v # α)  C𝒱 = []" 
      unfolding isViewOn_def V_valid_def VC_disjoint_def projection_def by auto
    ultimately
    have "β @ [c , v] @ α  TrES" using SIA unfolding SIA_def by auto
    with alpha_C_empty  
    have "α'. δ'. 
              (set δ')  (N𝒱  ΔΓ)  ((β @ [c] @ δ' @ [v] @ α')   TrES  
                 α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])" 
      by (metis append.simps(1) append.simps(2) bot_least list.set(1))
  }    
  thus ?thesis
    unfolding SIA_def FCIA_def by auto
qed

(* lemma taken from lemma 3.5.13 from Heiko Mantel's dissertation*)
lemma FCI_implies_FCIA: 
"(FCI Γ 𝒱 TrES)  FCIA ρ Γ 𝒱 TrES" 
proof-
  assume FCI: "FCI Γ 𝒱 TrES"
  {
    fix α β c v
    assume "c  C𝒱   ΥΓ"
      and  "v  V𝒱  Γ"
      and  "β @ [v] @ α  TrES"
      and  "α  C𝒱 = []"
    with FCI have   "α' δ'. set δ'  N𝒱  ΔΓ 
                         β @ [c] @ δ' @ [v] @ α'  TrES  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []" 
                            unfolding FCI_def by auto   
  }
  thus ?thesis
    unfolding FCI_def FCIA_def by auto  
qed


(* Mantel's PhD thesis, Theorem 3.5.7 Trivially fulfilled BSPs*)
lemma Trivially_fulfilled_SR_C_empty:  
"C𝒱 = {}  SR 𝒱 TrES" 
proof -
  assume "C𝒱={}"
  {
    fix τ 
    assume "τ  TrES"
    hence "τ=τEES" using  validES 
      unfolding  ES_valid_def traces_contain_events_def projection_def by auto
    with ‹C𝒱={} have "τ=τ(V𝒱N𝒱)"
      using VIsViewOnE unfolding isViewOn_def by auto    
    with τ  TrES have "τ(V𝒱N𝒱)  TrES"
      by auto
  }
  thus ?thesis
    unfolding SR_def by auto
qed

lemma Trivially_fulfilled_R_C_empty: 
"C𝒱 = {}  R 𝒱 TrES" 
proof -
  assume "C𝒱={}"
  {
    fix τ 
    assume "τ  TrES"
    hence "τ=τEES" using  validES 
      unfolding  ES_valid_def traces_contain_events_def projection_def by auto
    with ‹C𝒱={} have "τ=τ(V𝒱N𝒱)"
      using VIsViewOnE unfolding isViewOn_def by auto    
    with τ  TrES ‹C𝒱={} have "τ'  TrES. τC𝒱=[]  τ' V𝒱=τV𝒱" 
      unfolding projection_def by auto
  }
  thus ?thesis
    unfolding R_def by auto
qed

lemma Trivially_fulfilled_SD_C_empty:  
"C𝒱 = {}  SD 𝒱 TrES" 
  by (simp add: SD_def)

lemma Trivially_fulfilled_BSD_C_empty: 
"C𝒱 = {}  BSD 𝒱 TrES"
  by (simp add: BSD_def)

lemma Trivially_fulfilled_D_C_empty:  
"C𝒱 = {}  D 𝒱 TrES" 
  by (simp add: D_def)

lemma Trivially_fulfilled_FCD_C_empty:  
"C𝒱 = {}  FCD Γ 𝒱 TrES" 
  by (simp add: FCD_def)

lemma Trivially_fullfilled_R_V_empty: 
"V𝒱={}  R 𝒱 TrES"
proof - 
  assume "V𝒱={}"
  {
    fix τ
    assume "τ  TrES"
    let ?τ'="[]"
    from τ  TrEShave "?τ'  TrES" 
      using validES 
      unfolding ES_valid_def traces_prefixclosed_def prefixclosed_def prefix_def by auto
    with ‹V𝒱={}
    have "τ'  TrES. τ'C𝒱=[]  τ'V𝒱=τV𝒱"  
      by (metis projection_on_empty_trace projection_to_emptyset_is_empty_trace)
  }
  thus ?thesis
    unfolding R_def by auto  
qed

lemma Trivially_fulfilled_BSD_V_empty: 
"V𝒱 = {}  BSD 𝒱 TrES"
proof -
  assume "V𝒱={}"
  {
    fix α β c
    assume "β @ [c] @ α  TrES"
      and "αC𝒱= []"  

    from β @ [c] @ α  TrES have "β  TrES"
      using validES 
      unfolding ES_valid_def traces_prefixclosed_def prefixclosed_def prefix_def by auto
 
    let ?α'="[]"
    from β  TrES ‹V𝒱={} 
    have "β@ ?α'TrES  ?α'V𝒱 = αV𝒱  ?α'C𝒱 = []"
      by (simp add: projection_on_empty_trace projection_to_emptyset_is_empty_trace)
    hence
    "α'. 
      β @ α'TrES  α'V𝒱 = αV𝒱  α'C𝒱 = []" by blast
  }
  thus ?thesis
    unfolding BSD_def by auto
qed

lemma Trivially_fulfilled_D_V_empty: 
"V𝒱 = {}  D 𝒱 TrES"
proof -
  assume "V𝒱={}"
  {
    fix α β c
    assume "β @ [c] @ α  TrES"
      and "αC𝒱= []"  
    
    from β @ [c] @ α  TrES have "β  TrES"
      using validES 
      unfolding ES_valid_def traces_prefixclosed_def prefixclosed_def prefix_def by auto
    
    let ?β'=β and  ?α'="[]"
    from β  TrES ‹V𝒱={} 
    have "?β'@ ?α'TrES  ?α'V𝒱 = αV𝒱  ?α'C𝒱 = []  ?β'(V𝒱  C𝒱) = β(V𝒱  C𝒱)"
      by (simp add: projection_on_empty_trace projection_to_emptyset_is_empty_trace)
    hence
    "α' β'. 
      β'@ α'TrES  α'V𝒱 = αV𝒱  α'C𝒱 = []  β'(V𝒱  C𝒱) = β(V𝒱  C𝒱)"
      by blast
  }
  thus ?thesis
    unfolding D_def by auto
qed

lemma Trivially_fulfilled_FCD_V_empty: 
"V𝒱 = {}  FCD Γ 𝒱 TrES"
  by (simp add: FCD_def)

(* Mantel's PhD thesis, Theorem 3.5.8 Trivially fulfilled BSPs*)
lemma Trivially_fulfilled_FCD_Nabla_Υ_empty: 
"Γ={}  ΥΓ={} FCD Γ 𝒱 TrES" 
proof -
  assume "∇Γ={}  ΥΓ={}"
  thus ?thesis
  proof(rule disjE)
    assume "∇Γ={}" thus ?thesis
      by (simp add: FCD_def)
  next
    assume " ΥΓ={}" thus ?thesis
      by (simp add: FCD_def)
  qed
qed

lemma Trivially_fulfilled_FCD_N_subseteq_Δ_and_BSD: 
"N𝒱  ΔΓ; BSD 𝒱 TrES  FCD Γ 𝒱 TrES"
proof -
  assume "N𝒱  ΔΓ"
     and "BSD 𝒱 TrES"
  {
    fix α β c v
    assume "c  C𝒱  ΥΓ"
       and "v  V𝒱 Γ"
       and "β @ [c,v] @ α  TrES"
       and "αC𝒱 = []"
    from c  C𝒱  ΥΓ have "c  C𝒱"
      by auto
    from v  V𝒱 Γ have "v  V𝒱"
      by auto
    
    let ="[v] @ α"
    from v  V𝒱 αC𝒱 = [] have "C𝒱=[]"
      using VIsViewOnE 
      unfolding isViewOn_def V_valid_def VC_disjoint_def projection_def by auto
    from β @ [c,v] @ α  TrES have "β @ [c] @   TrES"
      by auto
    
    from ‹BSD 𝒱 TrES 
    obtain α' 
      where "β @ α'  TrES"
        and "α'V𝒱 = ([v] @ α)V𝒱"
        and "α'C𝒱 = []"
      using c  C𝒱  β @ [c] @   TrES C𝒱 = [] 
      unfolding BSD_def by auto 

    fromv  V𝒱 α'V𝒱 = ([v] @ α)V𝒱 have "α'V𝒱 = [v] @ αV𝒱" 
      by (simp add: projection_def)
    then obtain δ α''
      where "α'=δ @ [v] @ α''"
        and "δV𝒱 = []"
        and "α''V𝒱 = αV𝒱"
       using projection_split_first_with_suffix by fastforce 

    from α'C𝒱 = [] α'=δ @ [v] @ α'' have "δC𝒱=[]"
      by (metis append_is_Nil_conv projection_concatenation_commute) 
    from α'C𝒱 = [] α'=δ @ [v] @ α'' have "α''C𝒱=[]" 
      by (metis append_is_Nil_conv projection_concatenation_commute) 
    
    from β @ α'  TrES have "set α'  EES" using validES 
      unfolding ES_valid_def traces_contain_events_def by auto
    with  α'=δ @ [v] @ α'' have "set δ  EES"
      by auto
    with  δC𝒱=[] δV𝒱 = [] ‹N𝒱  ΔΓ
    have "(set δ)  (N𝒱  ΔΓ)" 
      using VIsViewOnE projection_empty_implies_absence_of_events  
      unfolding isViewOn_def projection_def by blast
    
    let =β and ?δ'=δ and ?α'=α''
    from (set δ)  (N𝒱  ΔΓ) β @ α'  TrES α'=δ @ [v] @ α'' 
            α''V𝒱 = αV𝒱 α''C𝒱=[]
    have "(set ?δ')(N𝒱  ΔΓ)   @ ?δ' @ [v] @ ?α'  TrES  ?α'V𝒱=αV𝒱  ?α'C𝒱=[]"
      by auto
    hence "α''' δ''. (set δ'')  (N𝒱  ΔΓ)  (β @ δ'' @ [v] @ α''')  TrES 
               α'''  V𝒱 = α  V𝒱  α'''  C𝒱 = []" 
      by auto 
  }
  thus ?thesis
    unfolding FCD_def by auto  
qed

(* Mantel's PhD thesis, Theorem 3.5.16 Trivially fulfilled BSPs*)
lemma Trivially_fulfilled_SI_C_empty:  
"C𝒱 = {}  SI 𝒱 TrES" 
  by (simp add: SI_def)

lemma Trivially_fulfilled_BSI_C_empty: 
"C𝒱 = {}  BSI 𝒱 TrES"
  by (simp add: BSI_def)

lemma Trivially_fulfilled_I_C_empty:  
"C𝒱 = {}  I 𝒱 TrES" 
  by (simp add: I_def)

lemma Trivially_fulfilled_FCI_C_empty:  
"C𝒱 = {}  FCI Γ 𝒱 TrES"
  by (simp add: FCI_def)

lemma Trivially_fulfilled_SIA_C_empty:  
"C𝒱 = {}  SIA ρ 𝒱 TrES" 
  by (simp add: SIA_def)

lemma Trivially_fulfilled_BSIA_C_empty: 
"C𝒱 = {}  BSIA ρ 𝒱 TrES"
  by (simp add: BSIA_def)

lemma Trivially_fulfilled_IA_C_empty:  
"C𝒱 = {}  IA ρ 𝒱 TrES" 
  by (simp add: IA_def)

lemma Trivially_fulfilled_FCIA_C_empty:  
"C𝒱 = {}  FCIA Γ ρ 𝒱 TrES" 
  by (simp add: FCIA_def)

lemma Trivially_fulfilled_FCI_V_empty: 
"V𝒱 = {}  FCI Γ 𝒱 TrES"
  by (simp add: FCI_def)

lemma Trivially_fulfilled_FCIA_V_empty: 
"V𝒱 = {}  FCIA ρ Γ 𝒱 TrES"
  by (simp add: FCIA_def)

lemma Trivially_fulfilled_BSIA_V_empty_rho_subseteq_C_N: 
"V𝒱 = {}; ρ 𝒱  (C𝒱  N𝒱)   BSIA ρ  𝒱 TrES" 
proof -
  assume "V𝒱={}"
     and "ρ 𝒱  (C𝒱  N𝒱)"
  {
    fix α β c 
    assume "c  C𝒱" 
       and "β @ α  TrES"
       and "αC𝒱=[]"
       and "Adm 𝒱 ρ TrES β c"
    from ‹Adm 𝒱 ρ TrES β c 
    obtain γ 
      where "γ @ [c]  TrES"
        and "γ(ρ 𝒱) = β(ρ 𝒱)"
      unfolding Adm_def by auto
    from this(1) have "γ  TrES" 
      using validES 
      unfolding ES_valid_def traces_prefixclosed_def prefixclosed_def prefix_def by auto 
    moreover
    from β @ α  TrES have "β  TrES"
      using validES
      unfolding ES_valid_def traces_prefixclosed_def prefixclosed_def prefix_def by auto
    ultimately
    have "βEES=γEES" 
      using validES VIsViewOnE ‹V𝒱={} γ(ρ 𝒱) = β(ρ 𝒱) ρ 𝒱  (C𝒱  N𝒱) 
        non_empty_projection_on_subset
      unfolding ES_valid_def isViewOn_def traces_contain_events_def 
      by (metis  empty_subsetI sup_absorb2 sup_commute)
    hence "β @ [c]  TrES" using validES γ @ [c]  TrES β  TrES γ  TrES
      unfolding ES_valid_def traces_contain_events_def 
      by (metis  list_subset_iff_projection_neutral subsetI)
    
    let ?α'="[]"
    from β @ [c]  TrES ‹V𝒱 = {} 
    have "β @ [c] @ ?α' TrES  ?α'V𝒱 = αV𝒱  ?α'C𝒱 = []" 
      by (simp add: projection_on_empty_trace projection_to_emptyset_is_empty_trace)
    hence " α'. β @ [c] @ α' TrES  α'V𝒱 = αV𝒱  α'C𝒱 = []" 
      by auto  
  }
  thus ?thesis
    unfolding BSIA_def by auto
qed

lemma Trivially_fulfilled_IA_V_empty_rho_subseteq_C_N: 
"V𝒱 = {}; ρ 𝒱  (C𝒱  N𝒱)   IA ρ  𝒱 TrES" 
proof -
  assume "V𝒱={}"
     and "ρ 𝒱  (C𝒱  N𝒱)"
  {
    fix α β c 
    assume "c  C𝒱" 
       and "β @ α  TrES"
       and "αC𝒱=[]"
       and "Adm 𝒱 ρ TrES β c"
    from ‹Adm 𝒱 ρ TrES β c
    obtain γ 
      where "γ @ [c]  TrES"
        and "γ(ρ 𝒱) = β(ρ 𝒱)"
        unfolding Adm_def by auto
    from this(1) have "γ  TrES"
      using validES 
      unfolding ES_valid_def traces_prefixclosed_def prefixclosed_def prefix_def by auto 
    moreover
    from β @ α  TrES have "β  TrES" using validES
      unfolding ES_valid_def traces_prefixclosed_def prefixclosed_def prefix_def by auto
    ultimately
    have "βEES=γEES" 
      using validES VIsViewOnE ‹V𝒱={} γ(ρ 𝒱) = β(ρ 𝒱) ρ 𝒱  (C𝒱  N𝒱) 
        non_empty_projection_on_subset
      unfolding ES_valid_def isViewOn_def traces_contain_events_def 
      by (metis  empty_subsetI sup_absorb2 sup_commute)
    hence "β @ [c]  TrES" using validES γ @ [c]  TrES β  TrES γ  TrES
      unfolding ES_valid_def traces_contain_events_def 
      by (metis  list_subset_iff_projection_neutral subsetI)
    
    let ?β'=β and ?α'="[]"
    from β @ [c]  TrES ‹V𝒱 = {} 
    have "?β' @ [c] @ ?α' TrES  ?α'V𝒱 = αV𝒱  ?α'C𝒱 = [] 
               ?β'(V𝒱  C𝒱) = β(V𝒱  C𝒱)" 
      by (simp add: projection_on_empty_trace projection_to_emptyset_is_empty_trace)
    hence " α' β'. 
              β' @ [c] @ α' TrES  α'V𝒱 = αV𝒱  α'C𝒱 = [] 
                 β'(V𝒱  C𝒱) = β(V𝒱  C𝒱)"
      by auto  
  }
  thus ?thesis
    unfolding IA_def by auto
qed

lemma Trivially_fulfilled_BSI_V_empty_total_ES_C: 
"V𝒱 = {}; total ES C𝒱   BSI 𝒱 TrES" 
proof -
  assume "V𝒱 = {}"
     and "total ES C𝒱"  
  {
   fix α β c
   assume "β @ α  TrES"
      and "αC𝒱=[]"
      and "c  C𝒱"
   from β @ α  TrES have "β  TrES" 
    using validES
    unfolding ES_valid_def traces_prefixclosed_def prefixclosed_def prefix_def by auto
   with ‹total ES C𝒱 have "β @ [c]  TrES" 
    using c  C𝒱  unfolding total_def by auto
   moreover
   from ‹V𝒱 = {} have "αV𝒱=[]"
     unfolding projection_def by auto
   ultimately 
   have "α'. β @ [c] @ α'  TrES  α'V𝒱=αV𝒱  α'C𝒱=[]" 
    using α  C𝒱 = []  by (metis append_Nil2 projection_idempotent)     
  }
  thus ?thesis
    unfolding BSI_def by auto
qed

lemma Trivially_fulfilled_I_V_empty_total_ES_C: 
"V𝒱 = {}; total ES C𝒱   I 𝒱 TrES" 
proof -
  assume "V𝒱 = {}"
     and "total ES C𝒱"  
  {
   fix α β c
   assume "c  C𝒱"
      and "β @ α  TrES"
      and "αC𝒱=[]"
   from β @ α  TrES have "β  TrES" 
     using validES
     unfolding ES_valid_def traces_prefixclosed_def prefixclosed_def prefix_def by auto
   with ‹total ES C𝒱 have "β @ [c]  TrES"
     using c  C𝒱  unfolding total_def by auto
   moreover
   from ‹V𝒱 = {} have "αV𝒱=[]"
     unfolding projection_def by auto
   ultimately 
   have "β' α'. 
          β' @ [c] @ α'  TrES  α'V𝒱=αV𝒱  α'C𝒱=[]  β'(V𝒱  C𝒱) = β(V𝒱  C𝒱)" 
    using α  C𝒱 = [] by (metis append_Nil2 projection_idempotent)     
  }
  thus ?thesis
    unfolding I_def by blast
qed

(* Mantel's PhD thesis, Theorem 3.5.17 Trivially fulfilled BSPs*)
lemma Trivially_fulfilled_FCI_Nabla_Υ_empty: 
"Γ={}  ΥΓ={} FCI Γ 𝒱 TrES" 
proof -
  assume "∇Γ={}  ΥΓ={}"
  thus ?thesis
  proof(rule disjE)
    assume "∇Γ={}" thus ?thesis
      by (simp add: FCI_def)
  next
    assume " ΥΓ={}" thus ?thesis
      by (simp add: FCI_def)
  qed
qed

lemma Trivially_fulfilled_FCIA_Nabla_Υ_empty: 
"Γ={}  ΥΓ={} FCIA ρ Γ 𝒱 TrES" 
proof -
  assume "∇Γ={}  ΥΓ={}"
  thus ?thesis
  proof(rule disjE)
    assume "∇Γ={}" thus ?thesis
      by (simp add: FCIA_def)
  next
    assume " ΥΓ={}" thus ?thesis
      by (simp add: FCIA_def)
  qed
qed

lemma Trivially_fulfilled_FCI_N_subseteq_Δ_and_BSI: 
"N𝒱  ΔΓ; BSI 𝒱 TrES  FCI Γ 𝒱 TrES" 
proof -
  assume "N𝒱  ΔΓ"
     and "BSI 𝒱 TrES"
  {
    fix α β c v
    assume "c  C𝒱  ΥΓ"
       and "v  V𝒱 Γ"
       and "β @ [v] @ α  TrES"
       and "αC𝒱 = []"
    from c  C𝒱  ΥΓ have "c  C𝒱"
      by auto
    from v  V𝒱 Γ have "v  V𝒱"
      by auto
    
    let ="[v] @ α"
    from v  V𝒱 αC𝒱 = [] have "C𝒱=[]"
      using VIsViewOnE 
      unfolding isViewOn_def V_valid_def VC_disjoint_def projection_def by auto
    from β @ [v] @ α  TrES have "β @    TrES"
      by auto
    
    from ‹BSI 𝒱 TrES 
    obtain α' 
      where "β @ [c] @ α'  TrES"
        and "α'V𝒱 = ([v] @ α)V𝒱"
        and "α'C𝒱 = []"
      using c  C𝒱  β @   TrES C𝒱 = [] 
      unfolding BSI_def by blast 

    fromv  V𝒱 α'V𝒱 = ([v] @ α)V𝒱 have "α'V𝒱 = [v] @ αV𝒱" 
      by (simp add: projection_def)
    then 
    obtain δ α''
      where "α'=δ @ [v] @ α''"
        and "δV𝒱 = []"
        and "α''V𝒱 = αV𝒱"
       using projection_split_first_with_suffix by fastforce 

    from α'C𝒱 = [] α'=δ @ [v] @ α'' have "δC𝒱=[]"
      by (metis append_is_Nil_conv projection_concatenation_commute) 
    from α'C𝒱 = [] α'=δ @ [v] @ α'' have "α''C𝒱=[]" 
      by (metis append_is_Nil_conv projection_concatenation_commute) 
    
    from β @ [c] @ α'  TrES have "set α'  EES" 
      using validES 
      unfolding ES_valid_def traces_contain_events_def by auto
    with  α'=δ @ [v] @ α'' have "set δ  EES" 
      by auto
    with  δC𝒱=[] δV𝒱 = [] ‹N𝒱  ΔΓ
    have "(set δ)  (N𝒱  ΔΓ)"
      using VIsViewOnE projection_empty_implies_absence_of_events  
      unfolding isViewOn_def projection_def by blast
    
    let =β and ?δ'=δ and ?α'=α''
    from (set δ)  (N𝒱  ΔΓ) β @ [c] @ α'  TrES α'=δ @ [v] @ α'' 
            α''V𝒱 = αV𝒱 α''C𝒱=[]
    have "(set ?δ')(N𝒱  ΔΓ)   @ [c] @ ?δ' @ [v] @ ?α'  TrES  ?α'V𝒱=αV𝒱  ?α'C𝒱=[]"
      by auto
    hence "α''' δ''. (set δ'')  (N𝒱  ΔΓ)  (β @ [c] @ δ'' @ [v] @ α''')  TrES 
               α'''  V𝒱 = α  V𝒱  α'''  C𝒱 = []" 
      by auto 
  }
  thus ?thesis
    unfolding FCI_def by auto  
qed

lemma Trivially_fulfilled_FCIA_N_subseteq_Δ_and_BSIA: 
"N𝒱  ΔΓ; BSIA ρ 𝒱 TrES  FCIA ρ Γ 𝒱 TrES" 
proof -
  assume "N𝒱  ΔΓ"
     and "BSIA ρ 𝒱 TrES"
  {
    fix α β c v
    assume "c  C𝒱  ΥΓ"
       and "v  V𝒱 Γ"
       and "β @ [v] @ α  TrES"
       and "αC𝒱 = []"
       and "Adm 𝒱 ρ TrES β c"
    from c  C𝒱  ΥΓ have "c  C𝒱" 
      by auto
    from v  V𝒱 Γ have "v  V𝒱" 
      by auto
    
    let ="[v] @ α"
    from v  V𝒱 αC𝒱 = [] have "C𝒱=[]"
      using VIsViewOnE 
      unfolding isViewOn_def V_valid_def VC_disjoint_def projection_def by auto
    from β @ [v] @ α  TrES have "β @    TrES" 
      by auto
    
    from ‹BSIA ρ 𝒱 TrES 
    obtain α' 
      where "β @ [c] @ α'  TrES"
        and "α'V𝒱 = ([v] @ α)V𝒱"
        and "α'C𝒱 = []"
      using c  C𝒱  β @   TrES C𝒱 = [] ‹Adm 𝒱 ρ TrES β c 
      unfolding BSIA_def by blast 

    fromv  V𝒱 α'V𝒱 = ([v] @ α)V𝒱 have "α'V𝒱 = [v] @ αV𝒱" 
      by (simp add: projection_def)
    then 
    obtain δ α''
      where "α'=δ @ [v] @ α''"
        and "δV𝒱 = []"
        and "α''V𝒱 = αV𝒱"
       using projection_split_first_with_suffix by fastforce 

    from α'C𝒱 = [] α'=δ @ [v] @ α'' have "δC𝒱=[]"
      by (metis append_is_Nil_conv projection_concatenation_commute) 
    from α'C𝒱 = [] α'=δ @ [v] @ α'' have "α''C𝒱=[]" 
      by (metis append_is_Nil_conv projection_concatenation_commute) 
    
    from β @ [c] @ α'  TrES have "set α'  EES" 
      using validES 
      unfolding ES_valid_def traces_contain_events_def by auto
    with  α'=δ @ [v] @ α'' have "set δ  EES" 
      by auto
    with  δC𝒱=[] δV𝒱 = [] ‹N𝒱  ΔΓ
    have "(set δ)  (N𝒱  ΔΓ)" using VIsViewOnE projection_empty_implies_absence_of_events  
      unfolding isViewOn_def projection_def by blast
    
    let =β and ?δ'=δ and ?α'=α''
    from (set δ)  (N𝒱  ΔΓ) β @ [c] @ α'  TrES α'=δ @ [v] @ α'' 
            α''V𝒱 = αV𝒱 α''C𝒱=[]
    have "(set ?δ')(N𝒱  ΔΓ)   @ [c] @ ?δ' @ [v] @ ?α'  TrES  ?α'V𝒱=αV𝒱  ?α'C𝒱=[]"
      by auto
    hence "α''' δ''. (set δ'')  (N𝒱  ΔΓ)  (β @ [c] @ δ'' @ [v] @ α''')  TrES 
               α'''  V𝒱 = α  V𝒱  α'''  C𝒱 = []" 
      by auto 
  }
  thus ?thesis
    unfolding FCIA_def by auto  
qed

end

context BSPTaxonomyDifferentViewsFirstDim
begin
(* lemma taken from lemma 3.5.2 in Heiko Mantel's dissertation *)
lemma R_implies_R_for_modified_view: 
"R 𝒱1 TrES  R 𝒱2 TrES"
proof -
  assume R_𝒱1: "R 𝒱1 TrES"
  {
    fix τ
    assume "τ  TrES" 
    with R_𝒱1 have " τ'  TrES.  τ'  C𝒱1 = []  τ'  V𝒱1 = τ  V𝒱1"
      unfolding R_def by auto 
    hence " τ'  TrES.  τ'  C𝒱2 = []  τ'  V𝒱2 = τ  V𝒱2" 
      using  V2_subset_V1  C2_subset_C1  non_empty_projection_on_subset projection_on_subset by blast
  }
  thus ?thesis
    unfolding R_def by auto
qed

lemma BSD_implies_BSD_for_modified_view: 
"BSD 𝒱1 TrES BSD 𝒱2 TrES"
proof- 
  assume BSD_𝒱1: "BSD 𝒱1 TrES"
  { 
    fix α β c n 
    assume  c_in_C2: "c  C𝒱2" 
    from C2_subset_C1  c_in_C2  have c_in_C1: "c  C𝒱1"
      by auto 
    have "β @ [c] @ α  TrES; α  C𝒱2=[]; n= length(α  C𝒱1)
              α'. β @ α'  TrES  α' V𝒱2 = α V𝒱2   α' C𝒱2 = []"
    proof(induct n arbitrary: α  )        
      case 0
        from "0.prems"(3) have "α  C𝒱1 = []" by auto
        with c_in_C1 "0.prems"(1) 
          have " α'. β @ α'  TrES  α'  V𝒱1 = α  V𝒱1  α' C𝒱1 =[]"
          using BSD_𝒱1 unfolding BSD_def by auto
        then 
        obtain α' where "β @ α'  TrES"
                    and "α'  V𝒱1 = α  V𝒱1"
                    and "α' C𝒱1 =[]"
          by auto
        from V2_subset_V1  α'  V𝒱1 = α  V𝒱1  have  "α' V𝒱2 = α V𝒱2" 
          using non_empty_projection_on_subset by blast
        moreover
        from α' C𝒱1 =[]  C2_subset_C1 have "α'  C𝒱2 = []" 
          using projection_on_subset by auto
        ultimately
        show ?case 
          using β @ α'  TrES by auto
      next
      case (Suc n)
        from "Suc.prems"(3) projection_split_last[OF "Suc.prems"(3)]  
        obtain γ1 γ2 c1 where c1_in_C1: "c1  C𝒱1"
                         and "α = γ1 @ [c1] @ γ2" 
                         and "γ2 C𝒱1 = []" 
                         and "n = length((γ1 @ γ2) C𝒱1)"
          by auto
        from  "Suc.prems"(2) α = γ1 @ [c1] @ γ2 have "γ1  C𝒱2 = []"
          by (simp add: projection_concatenation_commute)
        from  "Suc.prems"(1) α = γ1 @ [c1] @ γ2 
        obtain β' where "β'=β @ [c] @ γ1"
                    and "β' @ [c1] @ γ2  TrES"
          by auto
        from β' @ [c1] @ γ2  TrES  γ2 C𝒱1 = [] c1  C𝒱1 
        obtain γ2' where " β' @ γ2'  TrES"
                    and "γ2'  V𝒱1 = γ2  V𝒱1"
                    and "γ2' C𝒱1 =[]"
          using BSD_𝒱1  unfolding BSD_def by auto
        from β'=β @ [c] @ γ1 β' @ γ2'  TrES  have "β @ [c] @ γ1 @ γ2'  TrES"
          by auto 
        moreover
        from  γ1  C𝒱2=[]  γ2' C𝒱1 =[] C2_subset_C1 have "(γ1 @ γ2')  C𝒱2 =[]" 
          by (metis append_Nil projection_concatenation_commute projection_on_subset)
        moreover
        from n = length((γ1 @ γ2) C𝒱1) γ2 C𝒱1 = [] γ2' C𝒱1 =[] 
        have "n = length((γ1 @ γ2') C𝒱1)"
          by (simp add: projection_concatenation_commute)
        ultimately 
        have witness: " α'. β @ α'  TrES  α' V𝒱2 = (γ1 @ γ2') V𝒱2   α' C𝒱2 = []" 
          using  Suc.hyps by auto
        
        from  𝒱1IsViewOnE 𝒱2IsViewOnE V2_subset_V1 C2_subset_C1  c1_in_C1 have "c1  V𝒱2"  
          unfolding isViewOn_def V_valid_def  VC_disjoint_def by auto
        with α = γ1 @ [c1] @ γ2 have "α  V𝒱2 = (γ1 @ γ2)  V𝒱2" 
          unfolding projection_def by auto
        hence "α  V𝒱2 = γ1  V𝒱2 @ γ2  V𝒱2 " 
          using projection_concatenation_commute by auto
        with V2_subset_V1 γ2'  V𝒱1 = γ2  V𝒱1
        have "γ1  V𝒱2 @ γ2  V𝒱2 = γ1 V𝒱2 @ γ2'  V𝒱2" 
          using non_empty_projection_on_subset by metis
        with α  V𝒱2 = γ1  V𝒱2 @ γ2  V𝒱2 have "α  V𝒱2 = (γ1 @ γ2')  V𝒱2"
          by (simp add: projection_concatenation_commute)
       
       from witness  α  V𝒱2 = (γ1 @ γ2')  V𝒱2 
       show ?case 
         by auto
     qed          
 }  
  thus ?thesis 
    unfolding BSD_def by auto
qed

lemma D_implies_D_for_modified_view: 
"D 𝒱1 TrES  D 𝒱2 TrES"
proof- 
  assume D_𝒱1: "D 𝒱1 TrES"
   from V2_subset_V1 C2_subset_C1
    have V2_union_C2_subset_V1_union_C1: "V𝒱2  C𝒱2  V𝒱1  C𝒱1" by auto
  { 
    fix α β c n 
    assume  c_in_C2: "c  C𝒱2" 
    from C2_subset_C1  c_in_C2  have c_in_C1: "c  C𝒱1" 
      by auto 
    have "β @ [c] @ α  TrES; α  C𝒱2=[]; n= length(α  C𝒱1)
              α' β'. 
                  β' @ α'  TrES   α' V𝒱2 = α V𝒱2   α' C𝒱2 = [] 
                      β' (V𝒱2  C𝒱2) = β (V𝒱2  C𝒱2) "
    proof(induct n arbitrary: α β )        
      case 0
        from "0.prems"(3) have "α  C𝒱1 = []" by auto
        with c_in_C1 "0.prems"(1) 
        have " α' β'. 
                β' @ α'  TrES   α'  V𝒱1 = α  V𝒱1  α' C𝒱1 =[] 
                   β' (V𝒱1  C𝒱1) = β (V𝒱1  C𝒱1)"
          using D_𝒱1 unfolding D_def by fastforce
        then 
        obtain β' α' where "β' @ α'  TrES"
                      and "α'  V𝒱1 = α  V𝒱1"
                      and "α' C𝒱1 =[]"
                      and "β' (V𝒱1  C𝒱1) = β (V𝒱1  C𝒱1)" 
          by auto
        from V2_subset_V1  α'  V𝒱1 = α  V𝒱1  have  "α' V𝒱2 = α V𝒱2" 
          using non_empty_projection_on_subset by blast
        moreover
        from α' C𝒱1 =[]  C2_subset_C1 have "α'  C𝒱2 = []"
          using projection_on_subset by auto
        moreover
        from β' (V𝒱1  C𝒱1) = β (V𝒱1  C𝒱1)  V2_union_C2_subset_V1_union_C1 
        have "β' (V𝒱2  C𝒱2) = β (V𝒱2  C𝒱2)"
          using non_empty_projection_on_subset by blast
        ultimately
        show ?case 
          using β' @ α'  TrES by auto
      next
      case (Suc n)
        from "Suc.prems"(3) projection_split_last[OF "Suc.prems"(3)]  
        obtain γ1 γ2 c1 where c1_in_C1: "c1  C𝒱1"
                         and "α = γ1 @ [c1] @ γ2" 
                         and "γ2 C𝒱1 = []" 
                         and "n = length((γ1 @ γ2) C𝒱1)" 
          by auto
        from  "Suc.prems"(2) α = γ1 @ [c1] @ γ2 have "γ1  C𝒱2 = []" 
          by (simp add: projection_concatenation_commute)
        from  "Suc.prems"(1) α = γ1 @ [c1] @ γ2 
        obtain β' where "β'=β @ [c] @ γ1"
                    and "β' @ [c1] @ γ2  TrES"
          by auto
        from β' @ [c1] @ γ2  TrES  γ2 C𝒱1 = [] c1  C𝒱1 
        obtain γ2'  β'' where " β'' @ γ2'  TrES"
                         and "γ2'  V𝒱1 = γ2  V𝒱1"
                         and "γ2' C𝒱1 =[]"
                         and "β'' (V𝒱1  C𝒱1) = β' (V𝒱1  C𝒱1)" 
          using D_𝒱1  unfolding D_def by force
        
        from  c_in_C1 have "c  V𝒱1  C𝒱1"
          by auto  
        moreover
        from  β'' (V𝒱1  C𝒱1) = β' (V𝒱1  C𝒱1) β'=β @ [c] @ γ1  
        have "β'' (V𝒱1  C𝒱1) = (β @ [c] @ γ1) (V𝒱1  C𝒱1)"
          by auto 
        ultimately   
        have " β''' γ1'. β''=β'''@ [c] @ γ1' 
                            β'''  (V𝒱1  C𝒱1) = β (V𝒱1  C𝒱1) 
                            γ1'(V𝒱1  C𝒱1) = γ1 (V𝒱1  C𝒱1)" 
          using projection_split_arbitrary_element by fast
        then  
        obtain β''' γ1' where "β''= β''' @ [c] @ γ1'" 
                         and  "β'''  (V𝒱1  C𝒱1) = β (V𝒱1  C𝒱1)"
                         and  "γ1'(V𝒱1  C𝒱1) = γ1 (V𝒱1  C𝒱1)" 
          using projection_split_arbitrary_element  by auto 
        
        from β'' @ γ2'  TrES this(1)
        have "β''' @ [c] @ γ1' @ γ2'  TrES"
          by simp    

        from γ2' C𝒱1 =[] have "γ2'  C𝒱2=[]"
          using C2_subset_C1 projection_on_subset by auto
        moreover
        from γ1  C𝒱2 = [] γ1'(V𝒱1  C𝒱1) = γ1 (V𝒱1  C𝒱1) 
        have "γ1' C𝒱2 = []" using C2_subset_C1 V2_subset_V1 
          by (metis non_empty_projection_on_subset projection_subset_eq_from_superset_eq sup_commute)               
        ultimately
        have "(γ1' @ γ2')C𝒱2 = []" 
          by (simp add: projection_concatenation_commute)
          
        from γ1'(V𝒱1  C𝒱1) = γ1 (V𝒱1  C𝒱1) have "γ1'C𝒱1 = γ1C𝒱1" 
          using projection_subset_eq_from_superset_eq sup_commute by metis
        hence "length(γ1'C𝒱1) = length(γ1C𝒱1)" by simp
        moreover
        from γ2 C𝒱1 = [] γ2'C𝒱1=[] have "length(γ2'C𝒱1) = length(γ2C𝒱1)"
          by simp
        ultimately
        have "n=length((γ1' @ γ2')C𝒱1)" 
          by (simp add: n = length ((γ1 @ γ2)  C𝒱1) projection_concatenation_commute)

          
      
        from β''' @ [c] @ γ1' @ γ2'  TrES (γ1' @ γ2')C𝒱2 = [] n=length((γ1' @ γ2')C𝒱1) 
        have witness: 
        " α' β'. β' @ α'  TrES  α'  V𝒱2 = ( γ1' @ γ2')   V𝒱2 
                     α'  C𝒱2 = []  β'  (V𝒱2  C𝒱2) = β'''  (V𝒱2  C𝒱2)" 
          using Suc.hyps[OF β''' @ [c] @ γ1' @ γ2'  TrES] by simp
        
        from V2_union_C2_subset_V1_union_C1  β'''  (V𝒱1  C𝒱1) = β (V𝒱1  C𝒱1) 
        have "β'''  (V𝒱2  C𝒱2) = β (V𝒱2  C𝒱2)"
          using non_empty_projection_on_subset by blast
          
        from  𝒱1IsViewOnE 𝒱2IsViewOnE V2_subset_V1 C2_subset_C1  c1_in_C1 have "c1  V𝒱2"  
          unfolding isViewOn_def V_valid_def  VC_disjoint_def by auto
        with α = γ1 @ [c1] @ γ2 have "α  V𝒱2 = (γ1 @ γ2)  V𝒱2"
          unfolding projection_def by auto
        moreover
        from V2_subset_V1 γ2'  V𝒱1 = γ2  V𝒱1 have "γ2'  V𝒱2 = γ2  V𝒱2"
           using V2_subset_V1 by (metis projection_subset_eq_from_superset_eq subset_Un_eq)
        moreover
        from γ1'(V𝒱1  C𝒱1) = γ1 (V𝒱1  C𝒱1) have "γ1'  V𝒱2 = γ1  V𝒱2" 
          using V2_subset_V1 by (metis projection_subset_eq_from_superset_eq subset_Un_eq)
        ultimately  
        have "α  V𝒱2 = (γ1' @ γ2')  V𝒱2" using α  V𝒱2 = (γ1 @ γ2)  V𝒱2
          by (simp add: projection_concatenation_commute)

        from β'''  (V𝒱2  C𝒱2) = β (V𝒱2  C𝒱2) α  V𝒱2 = (γ1' @ γ2')  V𝒱2
        show ?case
          using witness by simp
     qed          
 }  
  thus ?thesis
    unfolding D_def by auto 
qed
end 

context BSPTaxonomyDifferentViewsSecondDim
begin
(* lemma taken from lemma 3.5.5 from Heiko Mantel's dissertation*)
lemma FCD_implies_FCD_for_modified_view_gamma: 
"FCD Γ1 𝒱1 TrES; 
     V𝒱2Γ2   V𝒱1Γ1;  N𝒱2ΔΓ2   N𝒱1ΔΓ1;  C𝒱2ΥΓ2   C𝒱1ΥΓ1 
      FCD Γ2 𝒱2 TrES" 
proof -
  assume "FCD Γ1 𝒱1 TrES"
     and "V𝒱2Γ2   V𝒱1Γ1"
     and "N𝒱2ΔΓ2   N𝒱1ΔΓ1" 
     and "C𝒱2ΥΓ2   C𝒱1ΥΓ1"
  {
    fix α β v c
    assume "c  C𝒱2ΥΓ2"
       and "v  V𝒱2Γ2"
       and "β @ [c,v] @ α  TrES"
       and "αC𝒱2 = []"
    
    from c  C𝒱2ΥΓ2 ‹C𝒱2ΥΓ2   C𝒱1ΥΓ1 have "c   C𝒱1ΥΓ1"
      by auto
    moreover
    from v  V𝒱2Γ2 ‹V𝒱2Γ2   V𝒱1Γ1 have "v   V𝒱1Γ1"
      by auto
    moreover
    from C2_equals_C1 αC𝒱2 = [] have "αC𝒱1 = []"
      by auto
    ultimately
    obtain α' δ' where "(set δ')  (N𝒱1  ΔΓ1)"
                  and "β @ δ' @ [v] @ α'  TrES"
                  and "α'V𝒱1 = αV𝒱1"
                  and "α'C𝒱1 = []"
      using β @ [c,v] @ α  TrES ‹FCD Γ1 𝒱1 TrES unfolding FCD_def by blast  
    
    from (set δ')  (N𝒱1  ΔΓ1) ‹N𝒱2ΔΓ2   N𝒱1ΔΓ1 
    have "(set δ')  (N𝒱2  ΔΓ2)"
      by auto
    moreover
    from α'V𝒱1 = αV𝒱1 V2_subset_V1 have "α'V𝒱2 = αV𝒱2" 
    using non_empty_projection_on_subset by blast
    moreover
    from C2_equals_C1 α'C𝒱1 = [] have "α'C𝒱2 = []"
      by auto
    ultimately
    have " δ' α'. (set δ')  (N𝒱2  ΔΓ2) 
                          β @ δ'@ [v] @ α'  TrES  α'V𝒱2 = αV𝒱2  α'C𝒱2 = []"
      using β @ δ' @ [v] @ α'  TrES by auto                
  }
  thus ?thesis
    unfolding FCD_def by blast
qed  

(* lemma taken from lemma 3.5.10 in Heiko Mantel's dissertation*)
lemma SI_implies_SI_for_modified_view : 
"SI 𝒱1 TrES  SI 𝒱2 TrES"
proof -
  assume  SI: "SI 𝒱1 TrES"
  {
    fix α β c
    assume "c  C𝒱2"
      and  "β @ α  TrES"
      and  alpha_C2_empty: "α  C𝒱2 = []"
    moreover
    with  C2_equals_C1 have "c  C𝒱1"
      by auto  
    moreover
    from   alpha_C2_empty C2_equals_C1 have "α  C𝒱1 = []"
      by auto
    ultimately
    have "β @ (c # α)  TrES"
      using SI  unfolding SI_def by auto
  }
  thus ?thesis
    unfolding SI_def by auto  
qed  


(* lemma taken from lemma 3.5.10 in Heiko Mantel's dissertation*)
lemma BSI_implies_BSI_for_modified_view : 
"BSI 𝒱1 TrES  BSI 𝒱2 TrES"
proof -
  assume  BSI: "BSI 𝒱1 TrES"
  {
    fix α β c
    assume "c  C𝒱2"
      and  "β @ α  TrES"
      and  alpha_C2_empty: "α  C𝒱2 = []"
    moreover
    with  C2_equals_C1 have "c  C𝒱1"
      by auto  
    moreover
    from   alpha_C2_empty C2_equals_C1 have "α  C𝒱1 = []"
      by auto
    ultimately
    have " α'. β @ [c] @ α'  TrES  α'  V𝒱1 = α  V𝒱1  α'  C𝒱1 = []" 
      using BSI  unfolding BSI_def by auto
    with V2_subset_V1  C2_equals_C1
    have " α'. β @ [c] @ α'  TrES  α'  V𝒱2 = α  V𝒱2  α'  C𝒱2 = []" 
      using non_empty_projection_on_subset by metis
  }
  thus ?thesis
    unfolding BSI_def by auto  
qed  

(* lemma taken from lemma 3.5.10 in Heiko Mantel's dissertation*)
lemma I_implies_I_for_modified_view : 
"I 𝒱1 TrES  I 𝒱2 TrES"
proof -
  assume  I: "I 𝒱1 TrES"
  from V2_subset_V1 C2_equals_C1 have V2_union_C2_subset_V1_union_C1: "V𝒱2  C𝒱2  V𝒱1  C𝒱1"
    by auto
  {
    fix α β c
    assume "c  C𝒱2"
      and  "β @ α  TrES"
      and  alpha_C2_empty: "α  C𝒱2 = []"
    moreover
    with C2_equals_C1 have "c  C𝒱1"
      by auto  
    moreover
    from   alpha_C2_empty C2_equals_C1 have "α  C𝒱1 = []" 
      by auto
    ultimately
    have " α' β'. 
            β' @ [c] @ α'  TrES  α'  V𝒱1 = α  V𝒱1  α'  C𝒱1 = [] 
               β'  (V𝒱1  C𝒱1) = β  (V𝒱1  C𝒱1)" 
      using I  unfolding I_def by auto
    with  V2_union_C2_subset_V1_union_C1 V2_subset_V1  C2_equals_C1
    have " α' β'. 
              β' @ [c] @ α'  TrES  α'  V𝒱2 = α  V𝒱2  α'  C𝒱2 = []  
                 β'  (V𝒱2  C𝒱2) = β  (V𝒱2  C𝒱2)" 
      using non_empty_projection_on_subset by metis
  }
  thus ?thesis
    unfolding I_def by auto  
qed  

(* lemma taken from lemma 3.5.10 in Heiko Mantel's dissertation*)
lemma SIA_implies_SIA_for_modified_view : 
"SIA ρ1 𝒱1 TrES; ρ2(𝒱2)  ρ1(𝒱1)   SIA ρ2 𝒱2 TrES"
proof -
  assume  SIA: "SIA ρ1 𝒱1 TrES"
    and   ρ2_supseteq_ρ1: "ρ2(𝒱2)  ρ1(𝒱1)" 
  {
    fix α β c
    assume "c  C𝒱2"
      and  "β @ α  TrES"
      and  alpha_C2_empty: "α  C𝒱2 = []"
      and admissible_c_ρ2_𝒱2:"Adm 𝒱2 ρ2 TrES β c"
    moreover
    with  C2_equals_C1 have "c  C𝒱1"
      by auto  
    moreover
    from   alpha_C2_empty C2_equals_C1 have "α  C𝒱1 = []"
      by auto
    moreover
    from ρ2_supseteq_ρ1  admissible_c_ρ2_𝒱2 have "Adm 𝒱1 ρ1 TrES β c" 
      by (simp add: Adm_implies_Adm_for_modified_rho)
    ultimately
    have "β @ (c # α)  TrES"
      using SIA  unfolding SIA_def by auto
  }
  thus ?thesis
    unfolding SIA_def by auto  
qed  


(* lemma taken from lemma 3.5.10 in Heiko Mantel's dissertation*)
lemma BSIA_implies_BSIA_for_modified_view : 
"BSIA ρ1 𝒱1 TrES; ρ2(𝒱2)  ρ1(𝒱1)   BSIA ρ2 𝒱2 TrES"
proof -
  assume  BSIA: "BSIA ρ1 𝒱1 TrES"
    and   ρ2_supseteq_ρ1: "ρ2(𝒱2)  ρ1(𝒱1)" 
  from V2_subset_V1 C2_equals_C1
  have V2_union_C2_subset_V1_union_C1: "V𝒱2  C𝒱2  V𝒱1  C𝒱1"
    by auto
  {
    fix α β c
    assume "c  C𝒱2"
      and  "β @ α  TrES"
      and  alpha_C2_empty: "α  C𝒱2 = []"
      and admissible_c_ρ2_𝒱2:"Adm 𝒱2 ρ2 TrES β c"
    moreover
    with  C2_equals_C1 have "c  C𝒱1"
      by auto  
    moreover
    from   alpha_C2_empty C2_equals_C1 have "α  C𝒱1 = []"
      by auto
    moreover
    from ρ2_supseteq_ρ1  admissible_c_ρ2_𝒱2 have "Adm 𝒱1 ρ1 TrES β c"
      by (simp add: Adm_implies_Adm_for_modified_rho)
    ultimately
    have " α'. β @ [c] @ α'  TrES  α'  V𝒱1 = α  V𝒱1  α'  C𝒱1 = []" 
      using BSIA  unfolding BSIA_def by auto
    with V2_subset_V1  C2_equals_C1 
    have " α'. β @ [c] @ α'  TrES  α'  V𝒱2 = α  V𝒱2  α'  C𝒱2 = []" 
      using non_empty_projection_on_subset by metis
  }
  thus ?thesis
    unfolding BSIA_def by auto  
qed  

(* lemma taken from lemma 3.5.10 in Heiko Mantel's dissertation*)
lemma IA_implies_IA_for_modified_view : 
"IA ρ1 𝒱1 TrES; ρ2(𝒱2)  ρ1(𝒱1)   IA ρ2 𝒱2 TrES"
proof -
  assume  IA: "IA ρ1 𝒱1 TrES"
    and   ρ2_supseteq_ρ1: "ρ2(𝒱2)  ρ1(𝒱1)" 
  {
    fix α β c
    assume "c  C𝒱2"
      and  "β @ α  TrES"
      and  alpha_C2_empty: "α  C𝒱2 = []"
      and admissible_c_ρ2_𝒱2:"Adm 𝒱2 ρ2 TrES β c"
    moreover
    with C2_equals_C1 have "c  C𝒱1"
      by auto  
    moreover
    from   alpha_C2_empty C2_equals_C1 have "α  C𝒱1 = []"
      by auto
    moreover
    from ρ2_supseteq_ρ1  admissible_c_ρ2_𝒱2 have "Adm 𝒱1 ρ1 TrES β c"
      by (simp add: Adm_implies_Adm_for_modified_rho)
    ultimately
    have " α' β'. β' @ [c] @ α'  TrES  α'  V𝒱1 = α  V𝒱1  α'  C𝒱1 = []  β'  (V𝒱1  C𝒱1) = β  (V𝒱1  C𝒱1)" 
      using IA  unfolding IA_def by auto
    moreover
    from   V2_subset_V1 C2_equals_C1 have "(V𝒱2  C𝒱2)   (V𝒱1  C𝒱1)"
      by auto 
    ultimately
    have " α' β'. β' @ [c] @ α'  TrES  α'  V𝒱2 = α  V𝒱2  α'  C𝒱2 = []   β'  (V𝒱2  C𝒱2) = β  (V𝒱2  C𝒱2)" 
      using V2_subset_V1  C2_equals_C1   non_empty_projection_on_subset by metis
  }
  thus ?thesis
    unfolding IA_def by auto  
qed

(* lemma taken from lemma 3.5.14 from Heiko Mantel's dissertation*)
lemma FCI_implies_FCI_for_modified_view_gamma: 
"FCI Γ1 𝒱1 TrES;
     V𝒱2Γ2   V𝒱1Γ1;  N𝒱2ΔΓ2   N𝒱1ΔΓ1;  C𝒱2ΥΓ2   C𝒱1ΥΓ1 
      FCI Γ2 𝒱2 TrES" 
proof -
  assume "FCI Γ1 𝒱1 TrES"
     and "V𝒱2Γ2   V𝒱1Γ1"
     and "N𝒱2ΔΓ2   N𝒱1ΔΓ1" 
     and "C𝒱2ΥΓ2   C𝒱1ΥΓ1"
  {
    fix α β v c
    assume "c  C𝒱2ΥΓ2"
       and "v  V𝒱2Γ2"
       and "β @ [v] @ α  TrES"
       and "αC𝒱2 = []"
    
    from c  C𝒱2ΥΓ2 ‹C𝒱2ΥΓ2   C𝒱1ΥΓ1 have "c   C𝒱1ΥΓ1"
      by auto
    moreover
    from v  V𝒱2Γ2 ‹V𝒱2Γ2   V𝒱1Γ1 have "v   V𝒱1Γ1"
      by auto
    moreover
    from C2_equals_C1 αC𝒱2 = [] have "αC𝒱1 = []"
      by auto
    ultimately 
    obtain α' δ' where "(set δ')  (N𝒱1  ΔΓ1)"
                  and "β @ [c] @ δ' @ [v] @ α'  TrES"
                  and "α'V𝒱1 = αV𝒱1"
                  and "α'C𝒱1 = []"
      using β @ [v] @ α  TrES ‹FCI Γ1 𝒱1 TrES unfolding FCI_def by blast  
    
    from (set δ')  (N𝒱1  ΔΓ1) ‹N𝒱2ΔΓ2   N𝒱1ΔΓ1 
    have "(set δ')  (N𝒱2  ΔΓ2)"
      by auto
    moreover
    from α'V𝒱1 = αV𝒱1 V2_subset_V1 have "α'V𝒱2 = αV𝒱2" 
      using non_empty_projection_on_subset by blast
    moreover
    from ‹C𝒱2 = C𝒱1 α'C𝒱1 = [] have "α'C𝒱2 = []"
      by auto
    ultimately have " δ' α'. (set δ')  (N𝒱2  ΔΓ2) 
                          β @ [c] @  δ'@ [v] @ α'  TrES  α'V𝒱2 = αV𝒱2  α'C𝒱2 = []"
               using β @ [c] @ δ' @ [v] @ α'  TrES by auto                
  }
  thus ?thesis
    unfolding FCI_def by blast
qed  


(* lemma taken from lemma 3.5.14 from Heiko Mantel's dissertation*)
lemma FCIA_implies_FCIA_for_modified_view_rho_gamma: 
"FCIA ρ1 Γ1 𝒱1 TrES; ρ2(𝒱2)  ρ1(𝒱1);
     V𝒱2Γ2   V𝒱1Γ1;  N𝒱2ΔΓ2   N𝒱1ΔΓ1;  C𝒱2ΥΓ2   C𝒱1ΥΓ1 
      FCIA ρ2 Γ2 𝒱2 TrES" 
proof -
  assume "FCIA ρ1 Γ1 𝒱1 TrES"
     and "ρ2(𝒱2)  ρ1(𝒱1)"
     and "V𝒱2Γ2   V𝒱1Γ1"
     and "N𝒱2ΔΓ2   N𝒱1ΔΓ1" 
     and "C𝒱2ΥΓ2   C𝒱1ΥΓ1"
  {
    fix α β v c
    assume "c  C𝒱2ΥΓ2"
       and "v  V𝒱2Γ2"
       and "β @ [v] @ α  TrES"
       and "αC𝒱2 = []"
       and "Adm 𝒱2 ρ2 TrES β c"
    
    from c  C𝒱2ΥΓ2 ‹C𝒱2ΥΓ2   C𝒱1ΥΓ1 have "c   C𝒱1ΥΓ1"
      by auto
    moreover
    from v  V𝒱2Γ2 ‹V𝒱2Γ2   V𝒱1Γ1 have "v   V𝒱1Γ1"
      by auto
    moreover
    from C2_equals_C1 αC𝒱2 = [] have "αC𝒱1 = []"
      by auto
    moreover
    from ‹Adm 𝒱2 ρ2 TrES β c ρ2(𝒱2)  ρ1(𝒱1) have "Adm 𝒱1 ρ1 TrES β c" 
       by (simp add: Adm_implies_Adm_for_modified_rho)
    ultimately
    obtain α' δ' where "(set δ')  (N𝒱1  ΔΓ1)"
                  and "β @ [c] @ δ' @ [v] @ α'  TrES"
                  and "α'V𝒱1 = αV𝒱1"
                  and "α'C𝒱1 = []"
      using β @ [v] @ α  TrES ‹FCIA ρ1 Γ1 𝒱1 TrES unfolding FCIA_def by blast  
    
    from (set δ')  (N𝒱1  ΔΓ1) ‹N𝒱2ΔΓ2   N𝒱1ΔΓ1 
    have "(set δ')  (N𝒱2  ΔΓ2)"
      by auto
    moreover
    from α'V𝒱1 = αV𝒱1 V2_subset_V1 have "α'V𝒱2 = αV𝒱2" 
      using non_empty_projection_on_subset by blast
    moreover
    from ‹C𝒱2 = C𝒱1 α'C𝒱1 = [] have "α'C𝒱2 = []"
      by auto
    ultimately
    have " δ' α'. (set δ')  (N𝒱2  ΔΓ2) 
                          β @ [c] @  δ'@ [v] @ α'  TrES  α'V𝒱2 = αV𝒱2  α'C𝒱2 = []"
      using β @ [c] @ δ' @ [v] @ α'  TrES by auto                
  }
  thus ?thesis
    unfolding FCIA_def by blast
qed   
end

end

Theory PropertyLibrary

theory PropertyLibrary
imports InformationFlowProperties "../SystemSpecification/EventSystems" "../Verification/Basics/BSPTaxonomy"
begin

(* The following properties assume a partition of the
event set into a set of low events (L) and a set of high
events (H), where low events are visible *)
definition 
HighInputsConfidential :: "'e set  'e set  'e set  'e V_rec"
where 
"HighInputsConfidential L H IE   V=L, N=H-IE, C=H  IE "

definition HighConfidential :: "'e set  'e set  'e V_rec"
where 
"HighConfidential L H   V=L, N={}, C=H "

fun interleaving :: "'e list  'e list  ('e list) set"
where
"interleaving t1 [] = {t1}" |
"interleaving [] t2 = {t2}" | 
"interleaving (e1 # t1) (e2 # t2) = 
  {t. (t'. t=(e1 # t')  t'  interleaving t1 (e2 #t2))}
   {t. (t'. t=(e2 # t')  t'  interleaving (e1 # t1) t2)}"


(* Generalized Noninterference [McC87] *)
(* MAKS representation *)
definition GNI :: "'e set  'e set  'e set  'e IFP_type"
where 
"GNI L H IE  ( {HighInputsConfidential L H IE}, {BSD, BSI})"

lemma GNI_valid: "L  H = {}  IFP_valid (L  H) (GNI L H IE)"
  unfolding IFP_valid_def GNI_def HighInputsConfidential_def isViewOn_def 
    V_valid_def VN_disjoint_def VC_disjoint_def NC_disjoint_def
  using BasicSecurityPredicates.BSP_valid_BSD BasicSecurityPredicates.BSP_valid_BSI 
  by auto
    
(* Literature representation *)
definition litGNI :: "'e set  'e set  'e set  ('e list) set  bool"
where 
"litGNI L H IE Tr  
   t1 t2 t3. 
    t1 @ t2  Tr  t3  (L  (H - IE)) = t2  (L  (H - IE))
      ( t4. t1 @ t4  Tr  t4(L  (H  IE)) = t3(L  (H  IE)))"  

(* Interleaving-based Generalized Noninterference [ZL97] *)
(* MAKS representation *) 
definition IBGNI :: "'e set  'e set  'e set  'e IFP_type"
where "IBGNI L H IE  ( {HighInputsConfidential L H IE}, {D, I})"

lemma IBGNI_valid: "L  H = {}  IFP_valid (L  H) (IBGNI L H IE)"
  unfolding IFP_valid_def IBGNI_def HighInputsConfidential_def isViewOn_def 
    V_valid_def VN_disjoint_def VC_disjoint_def NC_disjoint_def
  using BasicSecurityPredicates.BSP_valid_D BasicSecurityPredicates.BSP_valid_I 
  by auto    

(* Literature representation *) 
definition 
litIBGNI :: "'e set  'e set  'e set  ('e list) set  bool"  
where 
"litIBGNI L H IE Tr  
   τ_l  Tr.  t_hi t. 
    (set t_hi)  (H  IE)   t  interleaving t_hi (τ_l  L) 
       ( τ'  Tr. τ'  (L  (H  IE)) = t)"  

(* Forward Correctability [JT88] *)
(* MAKS representation *)  
definition FC :: "'e set  'e set  'e set  'e IFP_type"
where 
"FC L H IE  
  ( {HighInputsConfidential L H IE}, 
  {BSD, BSI, (FCD  Nabla=IE, Delta={}, Upsilon=IE ), 
             (FCI  Nabla=IE, Delta={}, Upsilon=IE  )})"

lemma FC_valid: "L  H = {}  IFP_valid (L  H) (FC L H IE)"
  unfolding IFP_valid_def FC_def HighInputsConfidential_def isViewOn_def 
    V_valid_def VN_disjoint_def VC_disjoint_def NC_disjoint_def
  using BasicSecurityPredicates.BSP_valid_BSD BasicSecurityPredicates.BSP_valid_BSI
    BasicSecurityPredicates.BSP_valid_FCD BasicSecurityPredicates.BSP_valid_FCI
  by auto  

(* Literature representation *)
definition litFC :: "'e set  'e set  'e set  ('e list) set  bool"
where 
"litFC L H IE Tr  
  t_1 t_2.  hi  (H  IE). 
  (
    ( li  (L  IE). 
      t_1 @ [li] @ t_2  Tr  t_2  (H  IE) = [] 
       ( t_3. t_1 @ [hi] @ [li] @ t_3  Tr 
                    t_3  L = t_2  L  t_3  (H  IE) = [] ))
       (t_1 @ t_2  Tr  t_2  (H  IE) = [] 
          ( t_3. t_1 @ [hi]  @ t_3  Tr 
                       t_3  L = t_2  L  t_3  (H  IE) = [] ))
      ( li  (L  IE). 
          t_1 @ [hi] @ [li] @ t_2  Tr  t_2  (H  IE) = [] 
            ( t_3. t_1 @ [li] @ t_3  Tr 
                         t_3  L = t_2  L  t_3  (H  IE) = [] )) 
           (t_1 @ [hi]  @ t_2  Tr  t_2  (H  IE) = [] 
              ( t_3. t_1  @ t_3  Tr 
                           t_3  L = t_2  L  t_3  (H  IE) = [] ))
  )"  

(* Nondeducibility for outputs [GN88] *)
(* MAKS representation *)
definition NDO :: "'e set  'e set  'e set  'e IFP_type"
where 
"NDO UI L H  
  ( {HighConfidential L H}, {BSD, (BSIA (λ 𝒱. C𝒱  (V𝒱  UI)))})"

lemma NDO_valid: "L  H = {}  IFP_valid (L  H) (NDO UI L H)"
  unfolding IFP_valid_def NDO_def HighConfidential_def isViewOn_def 
    V_valid_def VN_disjoint_def VC_disjoint_def NC_disjoint_def
  using BasicSecurityPredicates.BSP_valid_BSD
        BasicSecurityPredicates.BSP_valid_BSIA[of "(λ 𝒱. C𝒱  (V𝒱  UI))"]
  by auto 
  
(* Literature representation *)
definition litNDO :: "'e set  'e set  'e set  ('e list) set  bool"
where 
"litNDO UI L H Tr  
  τ_l  Tr.  τ_hlui  Tr.   t. 
    tL = τ_lL  t(H  (L  UI)) = τ_hlui(H  (L  UI))  t  Tr"  
  
(* Noninference [ZL97] *)
(* MAKS representation *)  
definition NF :: "'e set  'e set  'e IFP_type"
where 
"NF L H  ( {HighConfidential L H}, {R})"

lemma NF_valid: "L  H = {}  IFP_valid (L  H) (NF L H)"
  unfolding IFP_valid_def NF_def HighConfidential_def isViewOn_def 
    V_valid_def VN_disjoint_def VC_disjoint_def NC_disjoint_def
  using BasicSecurityPredicates.BSP_valid_R
  by auto     

(* Literature representation *)  
definition litNF :: "'e set  'e set  ('e list) set  bool"
where 
"litNF L H Tr  τ  Tr. τ  L  Tr"


(* Generalized Noninference [ZL97] *)
(* MAKS representation *)
definition GNF :: "'e set  'e set  'e set  'e IFP_type"
where 
"GNF L H IE  ( {HighInputsConfidential L H IE}, {R})"

lemma GNF_valid: "L  H = {}  IFP_valid (L  H) (GNF L H IE)"
  unfolding IFP_valid_def GNF_def HighInputsConfidential_def isViewOn_def 
    V_valid_def VN_disjoint_def VC_disjoint_def NC_disjoint_def
  using BasicSecurityPredicates.BSP_valid_R
  by auto       

(* Literature representation *)
definition litGNF :: "'e set  'e set  'e set  ('e list) set  bool"
where 
"litGNF L H IE Tr  
  τ  Tr. τ'  Tr. τ' (H  IE) = []  τ' L = τ  L"  
  
(* Separability [ZL97] *)
(* MAKS representation *)  
definition SEP :: "'e set  'e set  'e IFP_type"
where 
"SEP L H  ( {HighConfidential L H}, {BSD, (BSIA (λ 𝒱. C𝒱))})"

lemma SEP_valid: "L  H = {}  IFP_valid (L  H) (SEP L H)"
  unfolding IFP_valid_def SEP_def HighConfidential_def isViewOn_def 
    V_valid_def VN_disjoint_def VC_disjoint_def NC_disjoint_def
  using BasicSecurityPredicates.BSP_valid_BSD
        BasicSecurityPredicates.BSP_valid_BSIA[of "λ 𝒱. C𝒱"]
  by auto     
    
(* Literature representation *)
definition litSEP :: "'e set  'e set  ('e list) set  bool"
where 
"litSEP L H Tr  
  τ_l  Tr.  τ_h  Tr. 
    interleaving (τ_l  L) (τ_h  H)  {τ  Tr . τ  L = τ_l  L} "  

(* Perfect Security Property [ZL97] *)
(* MAKS representation *)
definition PSP :: "'e set  'e set  'e IFP_type"
where 
"PSP L H  
  ( {HighConfidential L H}, {BSD, (BSIA (λ 𝒱. C𝒱  N𝒱  V𝒱))})"

lemma PSP_valid: "L  H = {}  IFP_valid (L  H) (PSP L H)"
  unfolding IFP_valid_def PSP_def HighConfidential_def isViewOn_def 
    V_valid_def VN_disjoint_def VC_disjoint_def NC_disjoint_def
  using BasicSecurityPredicates.BSP_valid_BSD
        BasicSecurityPredicates.BSP_valid_BSIA[of "λ 𝒱. C𝒱  N𝒱  V𝒱"]
  by auto         

(* Literature representation *)
definition litPSP :: "'e set  'e set  ('e list) set  bool"
where 
"litPSP L H Tr  
  (τ  Tr. τ  L  Tr) 
     ( α β. (β @ α)  Tr  (α  H) = [] 
                 ( h  H. β @ [h]  Tr  β @ [h] @ α  Tr))"  

end

Theory SecureSystems

theory SecureSystems
imports "../../SystemSpecification/StateEventSystems"
  "../../SecuritySpecification/InformationFlowProperties"
begin

locale SecureESIFP =
fixes ES :: "'e ES_rec"
and IFP :: "'e IFP_type"

assumes validES: "ES_valid ES"
and validIFPES: "IFP_valid EES IFP"

(* sublocale relations for SecureESIFP *)

(* body of SecureESIFP *)
context SecureESIFP
begin

(* defines whether information flow property IFP 
  is satisfied for event system ES *)
definition ES_sat_IFP :: "bool"
where
"ES_sat_IFP  IFPIsSatisfied IFP TrES"

end


locale SecureSESIFP =
fixes SES :: "('s, 'e) SES_rec"
and IFP :: "'e IFP_type"

assumes validSES: "SES_valid SES"
and validIFPSES: "IFP_valid ESES IFP"

(* sublocale relations for SecureSESIFP *)

(* make theorems from SecureESIFP w.r.t. induceES visible in SecureSESIFP *)
sublocale SecureSESIFP  SecureESIFP "induceES SES" "IFP"
by (unfold_locales, rule induceES_yields_ES, rule validSES,
  simp add: induceES_def, rule validIFPSES)

(* body of SecureSESIFP *)
context SecureSESIFP
begin

abbreviation SES_sat_IFP
where 
"SES_sat_IFP  ES_sat_IFP"

end


end

Theory UnwindingConditions

theory UnwindingConditions
imports "../Basics/BSPTaxonomy"
  "../../SystemSpecification/StateEventSystems"
begin

locale Unwinding =
fixes SES :: "('s, 'e) SES_rec"
and 𝒱 :: "'e V_rec"

assumes validSES: "SES_valid SES"
and validVU: "isViewOn 𝒱 ESES"

(* sublocale relations for Unwinding *)
sublocale Unwinding  BSPTaxonomyDifferentCorrections "induceES SES" "𝒱"
  by (unfold_locales, simp add: induceES_yields_ES validSES,
    simp add: induceES_def validVU)

(* body of Unwinding *)
context Unwinding
begin

(* output step consistency (osc) *)
definition osc :: "'s rel  bool"
where
"osc ur  
  s1  SSES. s1'  SSES. s2'  SSES. e  (ESES - C𝒱).
    (reachable SES s1  reachable SES s1' 
        s1' eSES s2'  (s1', s1)  ur)
     (s2  SSES. δ. δ  C𝒱 = []  δ  V𝒱 = [e]  V𝒱 
           s1 δSES s2  (s2', s2)  ur)"

(* locally-respects forwards (lrf) *)
definition lrf :: "'s rel  bool"
where
"lrf ur  
  s  SSES. s'  SSES. c  C𝒱. 
  ((reachable SES s  s cSES s')  (s', s)  ur)"

(* locally-respects backwards (lrb) *)
definition lrb :: "'s rel  bool"
where
"lrb ur  s  SSES. c  C𝒱. 
  (reachable SES s  (s'  SSES. (s cSES s'  ((s, s')  ur))))"

(* forward-correctably respects forwards (fcrf) *)
definition fcrf :: "'e Gamma  's rel  bool"
where
"fcrf Γ ur  
  c  (C𝒱  ΥΓ). v  (V𝒱 Γ). s  SSES. s'  SSES.
    ((reachable SES s  s ([c] @ [v])SES s')
       (s''  SSES. δ. (d  (set δ). d  (N𝒱  ΔΓ)) 
             s (δ @ [v])SES s''  (s', s'')  ur))"

(* forward-correctably respects backwards (fcrb) *)
definition fcrb :: "'e Gamma  's rel  bool"
where 
"fcrb Γ ur  
  c  (C𝒱  ΥΓ). v  (V𝒱 Γ). s  SSES. s''  SSES.
  ((reachable SES s  s vSES s'')
     (s'  SSES. δ. (d  (set δ). d  (N𝒱  ΔΓ)) 
          s ([c] @ δ @ [v])SES s'  (s'', s')  ur))"

(* ρ-enabledness *)
definition En :: "'e Rho  's  'e  bool"
where
"En ρ s e  
  β γ. s'  SSES. s''  SSES.
    s0SES βSES s  (γ  (ρ 𝒱) = β  (ρ 𝒱)) 
      s0SES γSES s'  s' eSES s''"

(* locally-respects backwards for enabled events (lrbe) *)
definition lrbe :: "'e Rho  's rel  bool"
where
"lrbe ρ ur  
  s  SSES. c  C𝒱 .  
  ((reachable SES s  (En ρ s c)) 
     (s'  SSES. (s cSES s'  (s, s')  ur)))"

(* forward-correctable respects backwards for enabled events (fcrbe) *)
definition fcrbe :: "'e Gamma  'e Rho  's rel  bool"
where
"fcrbe Γ ρ ur  
  c  (C𝒱  ΥΓ). v  (V𝒱 Γ). s  SSES. s''  SSES.
  ((reachable SES s  s vSES s''  (En ρ s c))
     (s'  SSES. δ. (d  (set δ). d  (N𝒱  ΔΓ)) 
           s ([c] @ δ @ [v])SES s'  (s'', s')  ur))"

end

end

Theory AuxiliaryLemmas

theory AuxiliaryLemmas
imports UnwindingConditions
begin


context Unwinding
begin

(* Main lemma on output step consistency 
 (Lemma 5.4.2 in Heiko Mantel's dissertation)*)
lemma osc_property: 
"s1 s1'.  osc ur; s1  SSES; s1'  SSES; α  C𝒱 = []; 
  reachable SES s1; reachable SES s1'; enabled SES s1' α; (s1', s1)  ur 
   (α'. α'  C𝒱 = []  α'  V𝒱 = α  V𝒱  enabled SES s1 α')" 
proof (induct α)
  case Nil
  have "[]  C𝒱 = [] 
    []  V𝒱 = []  V𝒱  enabled SES s1 []" 
    by (simp add: enabled_def projection_def)
  thus ?case by (rule exI)
next
  case (Cons e1 α1)
  assume osc_true: "osc ur"
  assume s1_in_S: "s1  SSES"
  assume s1'_in_S: "s1'  SSES"
  assume e1α1_C_empty: "(e1 # α1)  C𝒱 = []"
  assume reachable_s1: "reachable SES s1"
  assume reachable_s1': "reachable SES s1'"
  assume enabled_s1'_e1α1: "enabled SES s1' (e1 # α1)"
  assume unwindingrel_s1'_s1: "(s1', s1)  ur"

  have e1α1_no_c: "a  (set (e1 # α1)). a  (ESES - C𝒱)"
  proof -
    from reachable_s1' obtain β 
      where "s0SES βSES s1'"
      by(simp add: reachable_def, auto)
    moreover
    from enabled_s1'_e1α1 obtain s1337
      where "s1' (e1 # α1)SES s1337"
      by(simp add: enabled_def, auto)
    ultimately have "s0SES (β @ (e1 # α1))SES s1337"
      by(rule path_trans)
    hence "β @ (e1 # α1)  Tr(induceES SES)"
      by (simp add: induceES_def possible_traces_def enabled_def)
    with validSES induceES_yields_ES[of "SES"] have "a  (set (β @ (e1 # α1))). a  ESES"
      by (simp add: induceES_def ES_valid_def traces_contain_events_def)
    hence " a  (set (e1 # α1)). a  ESES"
      by auto
    with e1α1_C_empty show ?thesis
      by (simp only: projection_def filter_empty_conv, auto)
  qed

  from enabled_s1'_e1α1 obtain s2' where 
    s1'_e1_s2': "s1' e1SES s2'" 
    by (simp add: enabled_def, split if_split_asm, auto)
  with validSES have s2'_in_S: "s2'  SSES" 
    by (simp add: SES_valid_def correct_transition_relation_def)
  have reachable_s2': "reachable SES s2'"
  proof -
    from reachable_s1' obtain t where 
      path_to_s1': "s0SES tSES s1'" 
      by (simp add: reachable_def, auto)
    from s1'_e1_s2' have "s1' [e1]SES s2'" 
      by simp
    with path_to_s1' have "s0SES (t @ [e1])SES s2'" 
      by (simp add: path_trans)
    thus ?thesis by (simp add: reachable_def, rule exI)
  qed
  from s1'_e1_s2' enabled_s1'_e1α1 obtain sn' where 
    "s2' α1SES sn'" 
    by (simp add: enabled_def, auto)
  hence enabled_s2'_α1: "enabled SES s2' α1" 
    by (simp add: enabled_def)
  from e1α1_no_c have e1_no_c: "e1  (ESES - C𝒱)" 
    by simp
  from e1α1_no_c have α1_no_c: "a(set α1). (a  (ESES - C𝒱))" 
    by simp
  hence α1_proj_C_empty: "α1  C𝒱 = []"
    by (simp add: projection_def)
  from osc_true have 
    " s1  SSES; s1'  SSES; s2'  SSES; 
      e1  (ESES - C𝒱); reachable SES s1; reachable SES s1'; 
      s1' e1SES s2'; (s1', s1)  ur  
      (s2  SSES. δ. δ  C𝒱 = []
         (δ  V𝒱) = ([e1]  V𝒱)  (s1 δSES s2  
       ((s2', s2)  ur)))"
    by (simp add: osc_def)
  with s1_in_S s1'_in_S e1_no_c reachable_s1 reachable_s1' 
    s2'_in_S s1'_e1_s2' unwindingrel_s1'_s1 
  obtain s2 δ where 
    osc_conclusion: 
      "s2  SSES  δ  C𝒱 = [] 
      (δ  V𝒱) = ([e1]  V𝒱)  s1 δSES s2  
      ((s2', s2)  ur)"
    by auto
  hence δ_proj_C_empty: "δ  C𝒱 = []"
    by (simp add: projection_def)
  from osc_conclusion have s2_in_S: "s2  SSES" 
    by auto
  from osc_conclusion have unwindingrel_s2'_s2: "(s2', s2)  ur" 
    by auto
  have reachable_s2: "reachable SES s2"
  proof -
    from reachable_s1 obtain t where 
      path_to_s1: "s0SES tSES s1" 
      by (simp add: reachable_def, auto)
    from osc_conclusion have "s1 δSES s2" 
      by auto
    with path_to_s1 have "s0SES (t @ δ)SES s2" 
      by (simp add: path_trans)
    thus ?thesis by (simp add: reachable_def, rule exI)
  qed

  from Cons osc_true s2_in_S s2'_in_S α1_proj_C_empty
    reachable_s2 reachable_s2' enabled_s2'_α1 unwindingrel_s2'_s2
  obtain α'' where α''_props:
    "α''  C𝒱 = []  α''  V𝒱 = α1  V𝒱  enabled SES s2 α''"
    by auto
  with osc_conclusion have  δα''_props:
    "(δ @ α'')  C𝒱 = []  
    (δ @ α'')  V𝒱 = (e1#α1)  V𝒱  enabled SES s1 (δ @ α'')"
    by (simp add: projection_def enabled_def, auto, simp add: path_trans)
  hence "(δ @ α'')  C𝒱 = []"
    by (simp add: projection_def)
  thus ?case using δα''_props by auto
qed

(* Paths will not bring us out of the domain of states.  *)
lemma path_state_closure: " s τSES s'; s  SSES   s'  SSES"
  (is " ?P s τ s'; ?S s SES   ?S s' SES ")
proof (induct τ arbitrary: s s')
  case Nil with validSES show ?case 
    by (auto simp add: SES_valid_def correct_transition_relation_def)
next
  case (Cons e τ) thus ?case
  proof -
    assume path_eτ: "?P s (e # τ) s'" 
    assume induct_hypo: " s s'.  ?P s τ s'; ?S s SES   ?S s' SES"
    
    from path_eτ obtain s'' where s_e_s'': "s eSES s''" 
      by(simp add: path_def, split if_split_asm, auto)
    with validSES have s''_in_S: "?S s'' SES" 
      by (simp add: SES_valid_def correct_transition_relation_def)
    
    from s_e_s'' path_eτ have path_τ: "?P s'' τ s'" by auto
    
    from path_τ s''_in_S show ?case by (rule induct_hypo)
  qed
qed


(* Theorem 5.4.7 split into two parts *)

(* first part *)
theorem En_to_Adm:
" reachable SES s; En ρ s e 
 β. ( s0SES βSES s  Adm 𝒱 ρ Tr(induceES SES) β e )" 
proof -
  assume "En ρ s e"
  then obtain β γ s' s'' 
    where "s0SES βSES s"
    and   "γ  (ρ 𝒱) = β  (ρ 𝒱)" 
    and   s0_γ_s': "s0SES γSES s'" 
    and   s'_e_s'': "s' eSES s''"
    by (simp add: En_def, auto)
  moreover 
    from s0_γ_s' s'_e_s'' have "s0SES (γ @ [e])SES s''"
      by (rule path_trans_single)
    hence "(γ @ [e])  Tr(induceES SES)"
      by(simp add: induceES_def possible_traces_def enabled_def)
  ultimately show ?thesis
    by (simp add: Adm_def, auto)
qed

(* second part *)
theorem Adm_to_En:
" β  Tr(induceES SES); Adm 𝒱 ρ Tr(induceES SES) β e 
 s  SSES. (s0SES βSES s  En ρ s e)"
proof -
  from validSES have s0_in_S: "s0SES  SSES"
       by (simp add: SES_valid_def s0_is_state_def) 
  
  assume "β  Tr(induceES SES)"
  then obtain s
    where s0_β_s: "s0SES βSES s"
    by (simp add: induceES_def possible_traces_def enabled_def, auto)
  from this have s_in_S: "s  SSES" using s0_in_S
    by (rule path_state_closure)

  assume  "Adm 𝒱 ρ Tr(induceES SES) β e"
  then obtain γ
    where ργ_is_ρβ: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
    and   "s''. s0SES (γ @ [e])SES s''"
    by(simp add: Adm_def induceES_def possible_traces_def enabled_def, auto)
  then obtain s''
    where  s0_γe_s'': "s0SES (γ @ [e])SES s''"
    by auto
  from this have s''_in_S: "s''  SSES" using s0_in_S
    by (rule path_state_closure)
  
  from path_split_single[OF s0_γe_s''] obtain s' 
    where s0_γ_s': "s0SES γSES s'"
    and s'_e_s'': "s' eSES s''"
    by auto

  from path_state_closure[OF s0_γ_s' s0_in_S] have s'_in_S: "s'  SSES". 
  
  from s'_in_S s''_in_S s0_β_s ργ_is_ρβ s0_γ_s' s'_e_s'' s_in_S show ?thesis 
    by (simp add: En_def, auto)
qed


(* It is a common pattern in the unwinding theorem proofs to obtain 
 a state from a given trace in a state event system and deduce some of its
 properties. This can be accomplished with the following lemma: 
*)
lemma state_from_induceES_trace: 
  "  (β @ α)  Tr(induceES SES)  
   s  SSES. s0SES βSES s  enabled SES s α  reachable SES s"
  proof -
    
    assume βα_in_Tr: "(β @ α)  Tr(induceES SES)"
    then obtain s' where  s0_βα_s':"s0SES (β @ α)SES s'" 
      by (simp add: induceES_def possible_traces_def enabled_def, auto)
    
    from path_split[OF s0_βα_s'] obtain s 
      where s0_β_s: "s0SES βSES s" 
      and "s αSES s'"
      by auto    
    hence enabled_s_α: "enabled SES s α"
      by (simp add: enabled_def)
    
    from s0_β_s have reachable_s: "reachable SES s"
      by(simp add: reachable_def, auto)
    
    from validSES have "s0SES  SSES"
      by (simp add: SES_valid_def s0_is_state_def)
    with s0_β_s have s_in_S: "s  SSES"
      by (rule path_state_closure)
    with s0_β_s enabled_s_α reachable_s show ?thesis
      by auto
  qed

(* Another common pattern in unwinding results: *)
lemma path_split2:"s0SES (β @ α)SES s 
   s'  SSES. ( s0SES βSES s'  s' αSES s  reachable SES s' )"
proof - 
  assume s0_βα_s: "s0SES (β @ α)SES s"

  from path_split[OF s0_βα_s] obtain s' 
    where s0_β_s': "s0SES βSES s'"
    and s'_α_s: "s' αSES s"
    by auto
  hence "reachable SES s'"
    by(simp add: reachable_def, auto)  
  moreover
  have "s'  SSES"
    proof -
      from s0_β_s' validSES path_state_closure show ?thesis
        by (auto simp add: SES_valid_def s0_is_state_def)
    qed

  ultimately show ?thesis using s'_α_s s0_β_s'
    by(auto)
qed 


(* Variant for singleton lists *)
lemma path_split_single2:
  "s0SES (β @ [x])SES s
   s'  SSES. ( s0SES βSES s'  s' xSES s  reachable SES s' )"
proof - 
  assume s0_βx_s: "s0SES (β @ [x])SES s"

  from path_split2[OF s0_βx_s] show ?thesis
    by (auto, split if_split_asm, auto)
qed 

      
lemma modified_view_valid: "isViewOn V = (V𝒱  N𝒱), N = {}, C = C𝒱 ESES"
  using validVU 
    unfolding isViewOn_def V_valid_def VC_disjoint_def VN_disjoint_def NC_disjoint_def by auto
    
end

end

Theory UnwindingResults

theory UnwindingResults
imports AuxiliaryLemmas
begin

context Unwinding
begin
theorem unwinding_theorem_BSD:
" lrf ur; osc ur   BSD 𝒱 Tr(induceES SES)"
proof -
  assume lrf_true: "lrf ur"
  assume osc_true: "osc ur"

  { (* show that the conclusion of the BSP follows from the assumptions *)
    fix α β c
    assume c_in_C: "c  C𝒱"
    assume βcα_in_Tr: "((β @ [c]) @ α)  Tr(induceES SES)"
    assume α_contains_no_c: "α  C𝒱 = []"
 
    from state_from_induceES_trace[OF βcα_in_Tr] obtain s1'
      where s1'_in_S: "s1'  SSES" 
      and enabled_s1'_α: "enabled SES s1' α" 
      and s0_βc_s1': "s0SES (β @ [c])SES s1'"
      and reachable_s1': "reachable SES s1'"
      by auto
    
    from path_split_single2[OF s0_βc_s1'] obtain s1
      where s1_in_S: "s1  SSES" 
      and s0_β_s1: "s0SES βSES s1" 
      and s1_c_s1': "s1 cSES s1'"
      and reachable_s1: "reachable SES s1"
      by auto

    from s1_in_S s1'_in_S c_in_C reachable_s1 s1_c_s1' lrf_true 
    have s1'_ur_s1: "((s1', s1)  ur)"
      by (simp add: lrf_def, auto)

    from osc_property[OF osc_true s1_in_S s1'_in_S α_contains_no_c reachable_s1
      reachable_s1' enabled_s1'_α s1'_ur_s1]
    obtain α' 
      where α'_contains_no_c: "α'  C𝒱 = []"
      and α'_V_is_α_V: "α'  V𝒱 = α  V𝒱"
      and enabled_s1_α': "enabled SES s1 α'" 
      by auto
  
    have βα'_in_Tr: "β @ α'  Tr(induceES SES)"
    proof -
      note s0_β_s1
      moreover
      from enabled_s1_α' obtain s2
        where "s1 α'SES s2"
        by (simp add: enabled_def, auto)
      ultimately have "s0SES (β @ α')SES s2"
        by (rule path_trans)
      thus ?thesis
        by (simp add: induceES_def possible_traces_def enabled_def)
    qed
    
    from βα'_in_Tr α'_V_is_α_V α'_contains_no_c have 
      "α'. ((β @ α')  (Tr(induceES SES))  (α'  (V𝒱)) = (α  V𝒱)  α'  C𝒱 = [])"
      by auto
  }
  thus ?thesis 
    by (simp add: BSD_def) 
qed

theorem unwinding_theorem_BSI:
" lrb ur; osc ur   BSI 𝒱 Tr(induceES SES)"
proof -
  assume lrb_true: "lrb ur"
  assume osc_true: "osc ur"
  
  {   (* show that the conclusion of the BSP follows from the assumptions *)
    fix α β c
    assume c_in_C: "c  C𝒱"
    assume βα_in_ind_Tr: "(β @ α)  Tr(induceES SES)"
    assume α_contains_no_c: "α  C𝒱 = []"
    
    from state_from_induceES_trace[OF βα_in_ind_Tr] obtain s1
      where s1_in_S : "s1  SSES"
      and path_β_yields_s1:  "s0SES βSES s1" 
      and enabled_s1_α: "enabled SES s1 α"
      and reachable_s1: "reachable SES s1"
      by auto

    from reachable_s1 s1_in_S c_in_C  lrb_true 
    have "s1' SSES. s1 cSES s1'  (s1, s1')  ur"
      by(simp add: lrb_def) 
    then obtain s1' 
      where s1'_in_S: "s1'  SSES"
      and s1_trans_c_s1': "s1 cSES s1'"
      and s1_s1'_in_ur: "(s1, s1')  ur" 
      by auto

    have reachable_s1': "reachable SES s1'" 
    proof -
      from path_β_yields_s1 s1_trans_c_s1' have "s0SES (β @ [c])SES s1'"
        by (rule path_trans_single)
      thus ?thesis by (simp add: reachable_def, auto)
    qed
    
    from osc_property[OF osc_true s1'_in_S s1_in_S α_contains_no_c 
      reachable_s1' reachable_s1 enabled_s1_α s1_s1'_in_ur]
    obtain α' 
      where α'_contains_no_c: "α'  C𝒱 = []"
      and α'_V_is_α_V: "α'  V𝒱 = α  V𝒱"
      and enabled_s1'_α': "enabled SES s1' α'" 
      by auto

    have βcα'_in_ind_Tr: "β @ [c] @ α'  Tr(induceES SES)"
    proof -
      from path_β_yields_s1 s1_trans_c_s1' have "s0SES (β @ [c])SES s1'"
        by (rule path_trans_single)
      moreover
      from enabled_s1'_α' obtain s2
        where "s1' α'SES s2"
        by (simp add: enabled_def, auto)
      ultimately have "s0SES ((β @ [c]) @ α')SES s2"
        by (rule path_trans)
      thus ?thesis
        by (simp add: induceES_def possible_traces_def enabled_def)
    qed
    
    from βcα'_in_ind_Tr α'_V_is_α_V α'_contains_no_c 
    have "α'. β @ c # α'  Tr(induceES SES)  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []"
      by auto
  }
  thus ?thesis
    by(simp add: BSI_def)
qed

(* unwinding theorem for BSP BSIA *)
theorem unwinding_theorem_BSIA:
" lrbe ρ ur; osc ur   BSIA ρ 𝒱 Tr(induceES SES)"
proof -
  assume lrbe_true: "lrbe ρ ur"
  assume osc_true: "osc ur"
  
  { (* show that the conclusion of the BSP follows from the assumptions *)
    fix α β c
    assume c_in_C: "c  C𝒱"
    assume βα_in_ind_Tr: "(β @ α)  Tr(induceES SES)"
    assume α_contains_no_c: "α  C𝒱 = []"
    
    assume adm: "Adm 𝒱 ρ Tr(induceES SES) β c"
    
    from state_from_induceES_trace[OF βα_in_ind_Tr] 
    obtain s1 
      where s1_in_S : "s1  SSES"
      and s0_β_s1:  "s0SES βSES s1" 
      and enabled_s1_α: "enabled SES s1 α"  
      and reachable_s1: "reachable SES s1"
      by auto

        (* case distinction whether En is true or not *)
    have "α'. β @ [c] @ α'  Tr(induceES SES)  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []"
    proof cases
      assume en: "En ρ s1 c" (*first case, en is true *)

      from reachable_s1 s1_in_S c_in_C en lrbe_true 
      have "s1' SSES. s1 cSES s1'  (s1, s1')  ur"
        by(simp add: lrbe_def) 
      then obtain s1' 
        where s1'_in_S: "s1'  SSES"
        and s1_trans_c_s1': "s1 cSES s1'"
        and s1_s1'_in_ur: "(s1, s1')  ur" 
        by auto

      have reachable_s1': "reachable SES s1'" 
      proof -
        from s0_β_s1 s1_trans_c_s1' have "s0SES (β @ [c])SES s1'"
          by (rule path_trans_single)
        thus ?thesis by (simp add: reachable_def, auto)
      qed 

      from osc_property[OF osc_true s1'_in_S s1_in_S α_contains_no_c 
        reachable_s1' reachable_s1 enabled_s1_α s1_s1'_in_ur] 
      obtain α' 
        where α'_contains_no_c: "α'  C𝒱 = []"
        and α'_V_is_α_V: "α'  V𝒱 = α  V𝒱"
        and enabled_s1'_α': "enabled SES s1' α'" 
        by auto
      
      have βcα'_in_ind_Tr: "β @ [c] @ α'  Tr(induceES SES)"
      proof -
        from s0_β_s1 s1_trans_c_s1' have "s0SES (β @ [c])SES s1'"
          by (rule path_trans_single)
        moreover
        from enabled_s1'_α' obtain s2
          where "s1' α'SES s2"
          by (simp add: enabled_def, auto)
        ultimately have "s0SES ((β @ [c]) @ α')SES s2"
          by (rule path_trans)
        thus ?thesis
          by (simp add: induceES_def possible_traces_def enabled_def)
      qed
      
      from βcα'_in_ind_Tr α'_V_is_α_V α'_contains_no_c show ?thesis
        by auto
    next (* second case, en is false *)
      assume not_en: "¬ En ρ s1 c"
      
      let ?A = "(Adm 𝒱 ρ (Tr(induceES SES)) β c)"
      let ?E = "s  SSES. (s0SES βSES s  En ρ s c)"

      { (* show the contraposition of Adm_to_En *)
        assume adm: "?A" 
        
        from s0_β_s1 have β_in_Tr: "β  Tr(induceES SES)"
          by (simp add: induceES_def possible_traces_def enabled_def)
        
        from  β_in_Tr adm have "?E"
          by (rule Adm_to_En)
      }
      hence Adm_to_En_contr: "¬ ?E  ¬ ?A"
        by blast
      with s1_in_S s0_β_s1 not_en have not_adm: "¬ ?A"
        by auto
      with adm show ?thesis
        by auto
    qed
  }
  thus ?thesis 
    by (simp add: BSIA_def)
qed

theorem unwinding_theorem_FCD:
" fcrf Γ ur; osc ur   FCD Γ 𝒱 Tr(induceES SES)"
proof - 
  assume fcrf: "fcrf Γ ur"
  assume osc: "osc ur"

  { (* show that the conclusion of the BSP follows from the assumptions *)
    fix α β c v

    assume c_in_C_inter_Y: "c  (C𝒱  ΥΓ)"
    assume v_in_V_inter_Nabla: "v  (V𝒱 Γ)"
    assume βcvα_in_Tr: "((β @ [c] @ [v]) @ α)  Tr(induceES SES)"
    assume α_contains_no_c: "α  C𝒱 = []"

    from state_from_induceES_trace[OF βcvα_in_Tr] obtain s1'
      where s1'_in_S: "s1'  SSES"
      and s0_βcv_s1': "s0SES (β @ ([c] @ [v]))SES s1'"
      and enabled_s1'_α: "enabled SES s1' α"
      and reachable_s1': "reachable SES s1'"
      by auto
    
    from path_split2[OF s0_βcv_s1'] obtain s1 
      where s1_in_S: "s1  SSES"
      and s0_β_s1: "s0SES βSES s1"
      and s1_cv_s1': "s1 ([c] @ [v])SES s1'"
      and reachable_s1: "reachable SES s1"
      by (auto)

    from c_in_C_inter_Y v_in_V_inter_Nabla s1_in_S s1'_in_S reachable_s1 s1_cv_s1' fcrf
    have "s1''  SSES. δ. (d  (set δ). d  (N𝒱  ΔΓ)) 
      s1 (δ @ [v])SES s1''  (s1', s1'')  ur"
      by (simp add: fcrf_def)
    then obtain s1'' δ
      where s1''_in_S: "s1''  SSES"
      and δ_in_N_inter_Delta_star: "(d  (set δ). d  (N𝒱  ΔΓ))"
      and s1_δv_s1'': "s1 (δ @ [v])SES s1''"
      and s1'_ur_s1'': "(s1', s1'')  ur" 
      by auto
      
    have reachable_s1'': "reachable SES s1''"
    proof -
      from s0_β_s1 s1_δv_s1'' have "s0SES (β @ (δ @ [v]))SES s1''"
        by (rule path_trans)
      thus ?thesis
        by (simp add: reachable_def, auto)
    qed

    from osc_property[OF  osc s1''_in_S s1'_in_S α_contains_no_c 
      reachable_s1'' reachable_s1' enabled_s1'_α s1'_ur_s1'']
    obtain α' 
      where  α'_contains_no_c: "α'  C𝒱 = []"
      and α'_V_is_α_V: "α'  V𝒱 = α  V𝒱"
      and enabled_s1''_α': "enabled SES s1'' α'" 
      by auto

    have βδvα'_in_Tr: "β @ δ @ [v] @ α'  Tr(induceES SES)"
      proof -
        from s0_β_s1 s1_δv_s1'' have "s0SES (β @ δ @ [v])SES s1''"
          by (rule path_trans)
        moreover
        from enabled_s1''_α' obtain s2
          where "s1'' α'SES s2"
          by (simp add: enabled_def, auto)
        ultimately have "s0SES ((β @ δ @ [v]) @ α')SES s2"
          by (rule path_trans)
        thus ?thesis
          by (simp add: induceES_def possible_traces_def enabled_def)
      qed

      from δ_in_N_inter_Delta_star βδvα'_in_Tr α'_V_is_α_V α'_contains_no_c
      have "α'. δ'. set δ'  (N𝒱  ΔΓ)  β @ δ' @ [v] @ α'  Tr(induceES SES) 
         α'  V𝒱 = α  V𝒱  α'  C𝒱 = []"
        by auto
  }
  thus ?thesis
    by (simp add: FCD_def)
qed

theorem unwinding_theorem_FCI:
" fcrb Γ ur; osc ur   FCI Γ 𝒱 Tr(induceES SES)"
proof -
  assume fcrb: "fcrb Γ ur"
  assume osc: "osc ur"

  { (* show that the conclusion of the BSP follows from the assumptions *)
    fix α β c v

    assume c_in_C_inter_Y: "c  (C𝒱  ΥΓ)"
    assume v_in_V_inter_Nabla: "v  (V𝒱 Γ)"
    assume βvα_in_Tr: "((β @ [v]) @ α)  Tr(induceES SES)"
    assume α_contains_no_c: "α  C𝒱 = []"
  
    from state_from_induceES_trace[OF βvα_in_Tr] obtain s1''
      where s1''_in_S: "s1''  SSES"
      and s0_βv_s1'': "s0SES (β @ [v])SES s1''"
      and enabled_s1''_α: "enabled SES s1'' α"
      and reachable_s1'': "reachable SES s1''"
      by auto

    from path_split_single2[OF s0_βv_s1''] obtain s1 
      where s1_in_S: "s1  SSES"
      and s0_β_s1: "s0SES βSES s1"
      and s1_v_s1'': "s1 vSES s1''"
      and reachable_s1: "reachable SES s1"
      by (auto)

    from c_in_C_inter_Y v_in_V_inter_Nabla s1_in_S 
      s1''_in_S reachable_s1 s1_v_s1'' fcrb 
    have "s1'  SSES. δ. (d  (set δ). d  (N𝒱  ΔΓ))
       s1 ([c] @ δ @ [v])SES s1'
       (s1'', s1')  ur"
      by (simp add: fcrb_def)
    then obtain s1' δ
      where s1'_in_S: "s1'  SSES"
      and δ_in_N_inter_Delta_star: "(d  (set δ). d  (N𝒱  ΔΓ))"
      and s1_cδv_s1': "s1 ([c] @ δ @ [v])SES s1'"
      and s1''_ur_s1': "(s1'', s1')  ur" 
      by auto

    have reachable_s1': "reachable SES s1'"
    proof -
      from s0_β_s1 s1_cδv_s1' have "s0SES (β @ ([c] @ δ @ [v]))SES s1'"
        by (rule path_trans)
      thus ?thesis
        by (simp add: reachable_def, auto)
    qed
    
    from osc_property[OF osc s1'_in_S s1''_in_S α_contains_no_c 
      reachable_s1' reachable_s1'' enabled_s1''_α s1''_ur_s1']
    obtain α' 
      where  α'_contains_no_c: "α'  C𝒱 = []"
      and α'_V_is_α_V: "α'  V𝒱 = α  V𝒱"
      and enabled_s1'_α': "enabled SES s1' α'" 
      by auto

    have βcδvα'_in_Tr: "β @ [c] @ δ @ [v] @ α'  Tr(induceES SES)"
    proof -
      let ?l1 = "β @ [c] @ δ @ [v]"
      let ?l2 = "α'"
      from s0_β_s1 s1_cδv_s1' have "s0SES (?l1)SES s1'"
        by (rule path_trans)
      moreover
      from enabled_s1'_α' obtain s1337 where "s1' ?l2SES s1337"
        by (simp add: enabled_def, auto)
      ultimately have "s0SES (?l1 @ ?l2)SES s1337"
        by (rule path_trans)
      thus ?thesis
        by (simp add: induceES_def possible_traces_def enabled_def) 
    qed

from δ_in_N_inter_Delta_star βcδvα'_in_Tr α'_V_is_α_V α'_contains_no_c
    have "α' δ'.
      set δ'  (N𝒱  ΔΓ)  β @ [c] @ δ' @ [v] @ α'  Tr(induceES SES) 
       α'  V𝒱 = α  V𝒱  α'  C𝒱 = []"
      by auto
  }
  thus ?thesis
    by(simp add: FCI_def)     
qed

theorem unwinding_theorem_FCIA:
" fcrbe Γ ρ ur; osc ur   FCIA ρ Γ 𝒱 Tr(induceES SES)"
proof -
  assume fcrbe: "fcrbe Γ ρ ur"
  assume osc: "osc ur"

  { (* show that the conclusion of the BSP follows from the assumptions *)
    fix α β c v

    assume c_in_C_inter_Y: "c  (C𝒱  ΥΓ)"
    assume v_in_V_inter_Nabla: "v  (V𝒱 Γ)"
    assume βvα_in_Tr: "((β @ [v]) @ α)  Tr(induceES SES)"
    assume α_contains_no_c: "α  C𝒱 = []"
    assume adm: "Adm 𝒱 ρ Tr(induceES SES) β c"

    from state_from_induceES_trace[OF βvα_in_Tr] obtain s1''
      where s1''_in_S: "s1''  SSES"
      and s0_βv_s1'': "s0SES (β @ [v])SES s1''"
      and enabled_s1''_α: "enabled SES s1'' α"
      and reachable_s1'': "reachable SES s1''"
      by auto

    from path_split_single2[OF s0_βv_s1''] obtain s1 
      where s1_in_S: "s1  SSES"
      and s0_β_s1: "s0SES βSES s1"
      and s1_v_s1'': "s1 vSES s1''"
      and reachable_s1: "reachable SES s1"
      by (auto)
    
    have "α' δ'.(set δ'  (N𝒱  ΔΓ)  β @ [c] @ δ' @ [v] @ α'  Tr(induceES SES) 
       α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])"
    proof (cases)
      assume en: "En ρ s1 c"

      from c_in_C_inter_Y v_in_V_inter_Nabla s1_in_S s1''_in_S reachable_s1 s1_v_s1'' en fcrbe
      have "s1'  SSES. δ. (d  (set δ). d  (N𝒱  ΔΓ))
         s1 ([c] @ δ @ [v])SES s1'
         (s1'', s1')  ur"
        by (simp add: fcrbe_def)
      then  obtain s1' δ
        where s1'_in_S: "s1'  SSES"
        and δ_in_N_inter_Delta_star: "(d  (set δ). d  (N𝒱  ΔΓ))"
        and s1_cδv_s1': "s1 ([c] @ δ @ [v])SES s1'"
        and s1''_ur_s1': "(s1'', s1')  ur"
        by (auto)

      have reachable_s1': "reachable SES s1'"
      proof -
        from s0_β_s1 s1_cδv_s1' have "s0SES (β @ ([c] @ δ @ [v]))SES s1'"
          by (rule path_trans)
        thus ?thesis
          by (simp add: reachable_def, auto)
      qed
      
      from osc_property[OF osc s1'_in_S s1''_in_S α_contains_no_c reachable_s1' 
        reachable_s1'' enabled_s1''_α s1''_ur_s1']
      obtain α' 
        where  α'_contains_no_c: "α'  C𝒱 = []"
        and α'_V_is_α_V: "α'  V𝒱 = α  V𝒱"
        and enabled_s1'_α': "enabled SES s1' α'" 
        by auto

      have βcδvα'_in_Tr: "β @ [c] @ δ @ [v] @ α'  Tr(induceES SES)"
      proof -
        let ?l1 = "β @ [c] @ δ @ [v]"
        let ?l2 = "α'"
        from s0_β_s1 s1_cδv_s1' have "s0SES (?l1)SES s1'"
          by (rule path_trans)
        moreover
        from enabled_s1'_α' obtain s1337 where "s1' ?l2SES s1337"
          by (simp add: enabled_def, auto)
        ultimately have "s0SES (?l1 @ ?l2)SES s1337"
          by (rule path_trans)
        thus ?thesis
          by (simp add: induceES_def possible_traces_def enabled_def) 
      qed

      from δ_in_N_inter_Delta_star βcδvα'_in_Tr α'_V_is_α_V α'_contains_no_c
      show ?thesis
        by auto
    next
      assume not_en: "¬ En ρ s1 c"
      
      let ?A = "(Adm 𝒱 ρ Tr(induceES SES) β c)"
      let ?E = "s  SSES. (s0SES βSES s  En ρ s c)"

      { (* show the contraposition of Adm_to_En *)
        assume adm: "?A" 
        
        from s0_β_s1 have β_in_Tr: "β  Tr(induceES SES)"
          by (simp add: induceES_def possible_traces_def enabled_def)
        
        from  β_in_Tr adm have "?E"
          by (rule Adm_to_En)
      }
      hence Adm_to_En_contr: "¬ ?E  ¬ ?A"
        by blast
      with s1_in_S s0_β_s1 not_en have not_adm: "¬ ?A"
        by auto
      with adm show ?thesis
        by auto
    qed  
  }
  thus ?thesis
    by (simp add: FCIA_def)
qed

theorem unwinding_theorem_SD:
" 𝒱' =  V = (V𝒱  N𝒱), N = {}, C = C𝒱 ; 
  Unwinding.lrf SES 𝒱' ur; Unwinding.osc SES 𝒱' ur  
   SD 𝒱 Tr(induceES SES)"
proof -
  assume view'_def : "𝒱' = V = (V𝒱  N𝒱), N = {}, C = C𝒱"
  assume lrf_view' : "Unwinding.lrf SES 𝒱' ur"
  assume osc_view' : "Unwinding.osc SES 𝒱' ur"

  interpret modified_view: Unwinding "SES" "𝒱'"
    by (unfold_locales, rule validSES, simp add: view'_def modified_view_valid)
      
  from lrf_view' osc_view' have BSD_view' : "BSD 𝒱' Tr(induceES SES)"
     by (rule_tac ur="ur" in modified_view.unwinding_theorem_BSD)
  with view'_def BSD_implies_SD_for_modified_view show ?thesis 
    by auto
qed

theorem unwinding_theorem_SI:
" 𝒱' =  V = (V𝒱  N𝒱), N = {}, C = C𝒱 ; 
  Unwinding.lrb SES 𝒱' ur; Unwinding.osc SES 𝒱' ur  
   SI 𝒱 Tr(induceES SES)"
proof -
  assume view'_def : "𝒱' = V = V𝒱  N𝒱, N = {}, C = C𝒱"
  assume lrb_view' : "Unwinding.lrb SES 𝒱' ur"
  assume osc_view' : "Unwinding.osc SES 𝒱' ur"

  interpret modified_view: Unwinding "SES" "𝒱'"
    by (unfold_locales, rule validSES, simp add: view'_def modified_view_valid)

  from lrb_view' osc_view' have BSI_view' : "BSI 𝒱' Tr(induceES SES)"
     by (rule_tac ur="ur" in modified_view.unwinding_theorem_BSI)
  with view'_def BSI_implies_SI_for_modified_view show ?thesis 
    by auto
qed

theorem unwinding_theorem_SIA: 
" 𝒱' =  V = (V𝒱  N𝒱), N = {}, C = C𝒱 ; ρ 𝒱 = ρ 𝒱'; 
  Unwinding.lrbe SES 𝒱' ρ ur; Unwinding.osc SES 𝒱' ur  
   SIA ρ 𝒱 Tr(induceES SES)"
proof -
  assume view'_def : "𝒱' = V = V𝒱  N𝒱, N = {}, C = C𝒱"
  assume ρ_eq : "ρ 𝒱 = ρ 𝒱'"
  assume lrbe_view' : "Unwinding.lrbe SES 𝒱' ρ ur"
  assume osc_view' : "Unwinding.osc SES 𝒱' ur"

  interpret modified_view: Unwinding "SES" "𝒱'"
    by (unfold_locales, rule validSES, simp add: view'_def modified_view_valid)

  from lrbe_view' osc_view' have BSIA_view' : "BSIA ρ 𝒱' Tr(induceES SES)"
     by (rule_tac ur="ur" in modified_view.unwinding_theorem_BSIA)
  with view'_def BSIA_implies_SIA_for_modified_view ρ_eq show ?thesis 
    by auto
qed 

theorem unwinding_theorem_SR:
" 𝒱' =  V = (V𝒱  N𝒱), N = {}, C = C𝒱 ; 
  Unwinding.lrf SES 𝒱' ur; Unwinding.osc SES 𝒱' ur  
   SR 𝒱 Tr(induceES SES)"
proof -
  assume view'_def : "𝒱' = V = V𝒱  N𝒱, N = {}, C = C𝒱"
  assume lrf_view' : "Unwinding.lrf SES 𝒱' ur"
  assume osc_view' : "Unwinding.osc SES 𝒱' ur"

  from lrf_view' osc_view' view'_def have S_view : "SD 𝒱 Tr(induceES SES)"
     by (rule_tac ur="ur" in  unwinding_theorem_SD, auto)
  with SD_implies_SR show ?thesis
    by auto
qed

theorem unwinding_theorem_D:
" lrf ur; osc ur   D 𝒱 Tr(induceES SES)"
proof -
  assume "lrf ur"
  and "osc ur"
  hence "BSD 𝒱 Tr(induceES SES)"
    by (rule unwinding_theorem_BSD)
  thus ?thesis
    by (rule BSD_implies_D)
qed

theorem unwinding_theorem_I:
" lrb ur; osc ur   I 𝒱 Tr(induceES SES)"
proof -
  assume "lrb ur"
  and "osc ur"
  hence "BSI 𝒱 Tr(induceES SES)"
    by (rule unwinding_theorem_BSI)
  thus ?thesis
    by (rule BSI_implies_I)
qed

theorem unwinding_theorem_IA:
" lrbe ρ ur; osc ur   IA ρ 𝒱 Tr(induceES SES)"
proof -
  assume "lrbe ρ ur"
  and "osc ur"
  hence "BSIA ρ 𝒱 Tr(induceES SES)"
    by (rule unwinding_theorem_BSIA)
  thus ?thesis
    by (rule BSIA_implies_IA)
qed

theorem unwinding_theorem_R:
" lrf ur; osc ur   R 𝒱 (Tr(induceES SES))"
proof -
  assume "lrf ur"
  and "osc ur"
  hence "BSD 𝒱 Tr(induceES SES)"
    by (rule unwinding_theorem_BSD)
  hence "D 𝒱 Tr(induceES SES)"
    by (rule BSD_implies_D)
  thus ?thesis
    by (rule D_implies_R)
qed

end

end

Theory CompositionBase

theory CompositionBase
imports "../Basics/BSPTaxonomy"
begin

definition 
properSeparationOfViews :: 
"'e ES_rec  'e ES_rec  'e V_rec  'e V_rec  'e V_rec  bool"
where
"properSeparationOfViews ES1 ES2 𝒱 𝒱1 𝒱2 
   V𝒱  EES1 = V𝒱1
    V𝒱  EES2 = V𝒱2
    C𝒱  EES1  C𝒱1
    C𝒱  EES2  C𝒱2
    N𝒱1  N𝒱2 = {}"

definition
wellBehavedComposition :: 
"'e ES_rec  'e ES_rec  'e V_rec  'e V_rec  'e V_rec  bool"
where
"wellBehavedComposition ES1 ES2 𝒱 𝒱1 𝒱2 
( N𝒱1  EES2 = {}  N𝒱2  EES1 = {} )
   (ρ1. ( N𝒱1  EES2 = {}  total ES1 (C𝒱1  N𝒱2) 
             BSIA ρ1 𝒱1 TrES1 ))
   (ρ2. ( N𝒱2  EES1 = {}  total ES2 (C𝒱2  N𝒱1) 
             BSIA ρ2 𝒱2 TrES2 ))
   (ρ1 ρ2 Γ1 Γ2. (Γ1  EES1  ΔΓ1  EES1  ΥΓ1  EES1
      Γ2  EES2  ΔΓ2  EES2  ΥΓ2  EES2
       BSIA ρ1 𝒱1 TrES1  BSIA ρ2 𝒱2 TrES2
       total ES1 (C𝒱1  N𝒱2)  total ES2 (C𝒱2  N𝒱1)
       FCIA ρ1 Γ1 𝒱1 TrES1  FCIA ρ2 Γ2 𝒱2 TrES2
       V𝒱1  V𝒱2 Γ1 Γ2
       C𝒱1  N𝒱2  ΥΓ1  C𝒱2  N𝒱1  ΥΓ2
       N𝒱1  ΔΓ1  EES2 = {}  N𝒱2  ΔΓ2  EES1 = {} ))"

locale Compositionality =
fixes ES1 :: "'e ES_rec"
and ES2 :: "'e ES_rec"
and 𝒱 :: "'e V_rec" (* view of the composed system *)
and 𝒱1 :: "'e V_rec" (* view for component ES1 *)
and 𝒱2 :: "'e V_rec" (* view for component ES2 *)

(* assumptions about the event systems *)
assumes validES1: "ES_valid ES1"
and validES2: "ES_valid ES2"
and composableES1ES2: "composable ES1 ES2"

(* basic assumptions about the views *)
and validVC: "isViewOn 𝒱 (E(ES1  ES2))"
and validV1: "isViewOn 𝒱1 EES1"
and validV2: "isViewOn 𝒱2 EES2"


(* the following assumptions constitute proper separation of views 
  (Def. 6.3.2 in Heiko Mantel's dissertation) *)
and propSepViews: "properSeparationOfViews ES1 ES2 𝒱 𝒱1 𝒱2" 

(* the following assumptions constitute well behaved composition (Def. 6.3.6 in Mantel's dissertation) *)
and well_behaved_composition: "wellBehavedComposition ES1 ES2 𝒱 𝒱1 𝒱2"



(* sublocale relations for Compositionality *)
sublocale Compositionality  BSPTaxonomyDifferentCorrections "ES1  ES2" "𝒱"
  by (unfold_locales, rule composeES_yields_ES, rule validES1,
    rule validES2, rule validVC)


(* body of Compositionality *)
context Compositionality
begin


(* proper separation of views implies the following equality *)
lemma Vv_is_Vv1_union_Vv2: "V𝒱 = V𝒱1  V𝒱2"
proof -
  from propSepViews have "V𝒱  EES1  V𝒱  EES2 = V𝒱1  V𝒱2"
    unfolding properSeparationOfViews_def by auto
  hence "V𝒱  (EES1  EES2) = V𝒱1  V𝒱2"
    by auto
  hence "V𝒱  E(ES1  ES2) = V𝒱1  V𝒱2"
    by (simp add: composeES_def)
  with validVC show ?thesis
    by (simp add: isViewOn_def, auto)
qed

lemma disjoint_Nv1_Vv2: "N𝒱1  V𝒱2 = {}"
proof -
  from validV1 have "N𝒱1  EES1"
    by (simp add: isViewOn_def, auto)
  with propSepViews have "N𝒱1  V𝒱2 = (N𝒱1  EES1  V𝒱)  EES2"
    unfolding properSeparationOfViews_def by auto
  hence "N𝒱1  V𝒱2 = (N𝒱1  V𝒱  EES1)  EES2"
    by auto
  moreover
  from validV1 have "N𝒱1  V𝒱  EES1 = {}" 
    using propSepViews unfolding properSeparationOfViews_def
    by (metis VN_disjoint_def V_valid_def inf_assoc inf_commute isViewOn_def)
  ultimately show ?thesis
    by auto      
qed

lemma disjoint_Nv2_Vv1: "N𝒱2  V𝒱1 = {}"
proof -
  from validV2 have "N𝒱2  EES2"
    by (simp add:isViewOn_def, auto)
  with propSepViews have "N𝒱2  V𝒱1 = (N𝒱2  EES2  V𝒱)  EES1"
    unfolding properSeparationOfViews_def by auto
  hence "N𝒱2  V𝒱1 = (N𝒱2  V𝒱  EES2)  EES1"
    by auto
  moreover
  from validV2 have "N𝒱2  V𝒱  EES2 = {}"
    using propSepViews unfolding properSeparationOfViews_def 
    by (metis VN_disjoint_def V_valid_def inf_assoc inf_commute isViewOn_def)
  ultimately show ?thesis
    by auto      
qed

(* An extended variant of the merge_property.
 Useful for the proof of the generalized zipping lemma. *)
lemma merge_property': "  set t1  EES1; set t2  EES2; 
  t1  EES2 = t2  EES1; t1  V𝒱 = []; t2  V𝒱 = []; 
  t1  C𝒱 = []; t2  C𝒱 = []  
  t. (t  EES1 = t1  t  EES2 = t2  t  V𝒱 = []  t  C𝒱 = []  set t  (EES1  EES2))"
proof -
  assume t1_in_E1star: "set t1  EES1"
  and t2_in_E2star: "set t2  EES2"
  and t1_t2_synchronized: "t1  EES2 = t2  EES1"
  and t1Vv_empty: "t1  V𝒱 = []"
  and t2Vv_empty: "t2  V𝒱 = []"
  and t1Cv_empty: "t1  C𝒱 = []"
  and t2Cv_empty: "t2  C𝒱 = []"

  from merge_property[OF t1_in_E1star t2_in_E2star t1_t2_synchronized] obtain t
    where t_is_interleaving: "t  EES1 = t1  t  EES2 = t2"
    and t_contains_only_events_from_t1_t2: "set t  set t1  set t2"
    unfolding Let_def
    by auto
  moreover
  from t1Vv_empty t2Vv_empty t_contains_only_events_from_t1_t2
  have "t  V𝒱 = []" 
    using propSepViews unfolding properSeparationOfViews_def
    by (metis Int_commute Vv_is_Vv1_union_Vv2 projection_on_union projection_sequence t_is_interleaving)
  moreover
  have "t  C𝒱 = []"
    proof -
      from t1Cv_empty have "c  C𝒱. c  set t1"
        by (simp add: projection_def filter_empty_conv, fast)
      moreover
      from t2Cv_empty have "c  C𝒱. c  set t2"
        by (simp add: projection_def filter_empty_conv, fast)
      ultimately have
      "c  C𝒱. c  (set t1  set t2)"
        by auto
      with t_contains_only_events_from_t1_t2 have "c  C𝒱. c  set t"
        by auto
      thus ?thesis
        by (simp add: projection_def, metis filter_empty_conv)
    qed
  moreover
  from t1_in_E1star t2_in_E2star t_contains_only_events_from_t1_t2 
  have "set t  (EES1  EES2)"
    by auto
  ultimately show ?thesis
    by blast
qed

lemma Nv1_union_Nv2_subsetof_Nv: "N𝒱1  N𝒱2  N𝒱"
proof -
  {
    fix e
    assume e_in_N1: "e  N𝒱1"
    with validV1 have 
      e_in_E1: "e  EES1"
      and e_notin_V1: "e  V𝒱1"
      and e_notin_C1: "e  C𝒱1"
      by (simp only: isViewOn_def V_valid_def VC_disjoint_def NC_disjoint_def
        VN_disjoint_def, auto)+
    
    from e_in_E1 e_notin_V1 propSepViews have "e  V𝒱"
     unfolding properSeparationOfViews_def by auto
    moreover
    from e_in_E1 e_notin_C1 propSepViews have "e  C𝒱"
     unfolding properSeparationOfViews_def by auto
    moreover
    note e_in_E1 validVC
    ultimately have "e  N𝒱"
      by (simp add: isViewOn_def V_valid_def VC_disjoint_def NC_disjoint_def VN_disjoint_def
         composeES_def, auto)
  }
  moreover {
    fix e
    assume e_in_N2: "e  N𝒱2"
    with validV2 have 
      e_in_E2: "e  E_ES ES2"
      and e_notin_V2: "e  V𝒱2"
      and e_notin_C2: "e  C𝒱2"
      by (simp only: isViewOn_def V_valid_def VC_disjoint_def NC_disjoint_def VN_disjoint_def
        , auto)+
    
    from e_in_E2 e_notin_V2 propSepViews have "e  V𝒱"
     unfolding properSeparationOfViews_def by auto
    moreover
    from e_in_E2 e_notin_C2 propSepViews have "e  C𝒱"
     unfolding properSeparationOfViews_def by auto
    moreover
    note e_in_E2 validVC
    ultimately have "e  N𝒱"
      by (simp add: isViewOn_def V_valid_def VC_disjoint_def VN_disjoint_def NC_disjoint_def
         composeES_def, auto)
  }
  ultimately show ?thesis
    by auto
qed

end

end

Theory CompositionSupport

theory CompositionSupport
imports CompositionBase
begin

locale CompositionSupport =
fixes ESi :: "'e ES_rec"
and 𝒱 :: "'e V_rec"
and 𝒱i :: "'e V_rec"

(* assumption about the component event system *)
assumes validESi: "ES_valid ESi"

(* assumption about the views (part of proper separation) *)
and validVi: "isViewOn 𝒱i EESi"
and Vv_inter_Ei_is_Vvi: "V𝒱  EESi = V𝒱i"
and Cv_inter_Ei_subsetof_Cvi: "C𝒱  EESi  C𝒱i"

(* sublocale relations for CompositionSupport *)

(* body of CompositionSupport *)
context CompositionSupport
begin

(* This lemma is used in the compositionality proof for BSD.
  Assuming that BSD holds for a subsystem ESi and given a trace β @ [c] @ α of the composed system,
  we can obtain a trace (β ↿ EESi) @ α_i' of ESi where α_i' contains no 
  events that are confidential in ESi and (α_i' ↿ V𝒱i) = (α ↿ V𝒱i) holds.
  
 𝒱 and 𝒱i denote views on the composition and subsystem respectively.
  We assume that 𝒱 and 𝒱i are properly separated. *)
lemma BSD_in_subsystem:
" c  C𝒱; ((β @ [c] @ α)  EESi)  TrESi ; BSD 𝒱i TrESi  
   α_i'. ( ((β  EESi) @ α_i')  TrESi 
   (α_i'  V𝒱i) = (α  V𝒱i)  α_i'  C𝒱i = [] )"
proof (induct "length (([c] @ α)  C𝒱i)" arbitrary: β c α)
  case 0
  (* show that ([c] @ α) ↿ EESi is a suitable choice for α_i' *)
  let ?L = "([c] @ α)  EESi"
  
  from 0(3) have β_E1_cα_E1_in_Tr1: "((β  EESi) @ (([c] @ α)  EESi))  TrESi"
    by (simp only: projection_concatenation_commute)
  moreover
  have "(?L  V𝒱i) = (α  V𝒱i)"
  proof -
    have "(?L  V𝒱i) = ([c] @ α)  V𝒱i"
    proof -
      from validVi have "EESi  V𝒱i = V𝒱i"
        by (simp add: isViewOn_def V_valid_def VN_disjoint_def VC_disjoint_def NC_disjoint_def 
          , auto)
      moreover
      have "(?L  V𝒱i) = ([c] @ α)  (EESi  V𝒱i)"
        by (simp add: projection_def)
      ultimately show ?thesis
        by auto
    qed
    moreover
    have "([c] @ α)  V𝒱i = α  V𝒱i"
    proof -
      have "([c] @ α)  V𝒱i = ([c]  V𝒱i) @ (α  V𝒱i)"
        by (rule projection_concatenation_commute)
      moreover
      have "([c]  V𝒱i) = []"
      proof -
        from 0(2) have "[c]  C𝒱 = [c]"
          by (simp add: projection_def)
        moreover
        have "[c]  C𝒱  V𝒱i = []"
        proof -
          from validVi Cv_inter_Ei_subsetof_Cvi have "C𝒱  V𝒱i  C𝒱i"
            by (simp add: isViewOn_def  V_valid_def VC_disjoint_def, auto)
          moreover
          from 0(1) have "[c]  C𝒱i = []"
            by (simp only: projection_concatenation_commute, auto)
          ultimately have "[c]  (C𝒱  V𝒱i) = []"
            by (rule projection_on_subset)
          thus ?thesis
            by (simp only: projection_def, auto)
        qed
        ultimately show ?thesis
          by auto
      qed
      ultimately show ?thesis
        by auto
    qed
    ultimately show ?thesis
      by auto
  qed
  moreover
  have "?L  C𝒱i = []"
  proof -
    from 0(1) have "([c] @ α)  C𝒱i = []"
      by auto
    hence "([c] @ α)  (C𝒱i  EESi) = []"
      by (rule projection_on_intersection)
    hence "([c] @ α)  (EESi  C𝒱i) = []"
      by (simp only: Int_commute)
    thus ?thesis
      by (simp only: projection_def, auto)                
  qed
  ultimately show ?case
    by auto
  
next
  case (Suc n)
  
  from projection_split_last[OF Suc(2)] obtain γ c_i δ
    where c_i_in_C𝒱i: "c_i  C𝒱i"
    and   cα_is_γc_iδ: "[c] @ α = γ @ [c_i] @ δ"
    and   δ_no_C𝒱i:  "δ  C𝒱i = []"
    and   n_is_len_γδ_C𝒱i: "n = length ((γ @ δ)  C𝒱i)"
    by auto
  
  let ?L1 = "((β @ γ)  EESi)"
  let ?L2 = "(δ  EESi)"

  note c_i_in_C𝒱i
  moreover
  have list_with_c_i_in_Tr1: "(?L1 @ [c_i] @ ?L2)  TrESi"
  proof -
    from c_i_in_C𝒱i validVi have "[c_i]  EESi = [c_i]"
      by (simp only: isViewOn_def V_valid_def VC_disjoint_def
        VN_disjoint_def NC_disjoint_def projection_def, auto)
    moreover
    from Suc(4) cα_is_γc_iδ have "((β @ γ @ [c_i] @ δ)  EESi)  TrESi"
      by auto
    hence "(?L1 @ ([c_i]  EESi) @ ?L2)  TrESi"
      by (simp only: projection_def, auto)
    ultimately show ?thesis
      by auto
  qed
  moreover 
  have "?L2  C𝒱i = []"
  proof -
    from validVi have "x. (x  EESi  x  C𝒱i) = (x  C𝒱i)"
      by (simp add: isViewOn_def V_valid_def VC_disjoint_def
        VN_disjoint_def NC_disjoint_def, auto)
    with δ_no_C𝒱i show ?thesis
      by (simp add: projection_def)
  qed            
  moreover note Suc(5)
  ultimately obtain δ'
    where δ'_1: "(?L1 @ δ')  TrESi"
    and δ'_2: "δ'  V𝒱i = ?L2  V𝒱i"
    and δ'_3: "δ'  C𝒱i = []"
    unfolding BSD_def
    by blast
  hence δ'_2': "δ'  V𝒱i = δ  V𝒱i"
  proof -
    have "?L2  V𝒱i = δ  V𝒱i"
    proof -
      from validVi have "x. (x  EESi  x  V𝒱i) = (x  V𝒱i)"
        by (simp add: isViewOn_def V_valid_def VC_disjoint_def
        VN_disjoint_def NC_disjoint_def, auto)
      thus ?thesis
        by (simp add: projection_def)
    qed
    with δ'_2 show ?thesis
      by auto
  qed
  
  show ?case
  proof (cases γ) (* need to distinguish between these cases as the inductive 
      hypothesis can only be applied to one case. *)
    case Nil
    with cα_is_γc_iδ have "[c] @ α = [c_i] @ δ"
      by auto
    hence δ_is_α: "δ = α"
      by auto
    
    from δ'_1 have δ'_1': "((β  EESi) @ δ')  TrESi"
      by (simp only: Nil, auto)
    moreover
    note δ'_2'
    moreover note δ'_3
    ultimately show ?thesis
      by (simp only: δ_is_α, auto)
  next
    case (Cons x γ')
    with cα_is_γc_iδ have γ_is_cγ': "γ = [c] @ γ'"
      by simp
    with n_is_len_γδ_C𝒱i have "n = length (([c] @ γ' @ δ)  C𝒱i)"
      by auto
    with δ_no_C𝒱i δ'_3 have "n = length (([c] @ γ' @ δ')  C𝒱i)"
      by (simp only: projection_concatenation_commute)
    moreover
    note Suc(3)
    moreover
    have "((β @ [c] @ (γ' @ δ'))  EESi)  TrESi"
    proof -
      from δ'_1 validESi have "δ' = δ'  EESi"
      proof -
        let ?L = "(β @ γ)  EESi @ δ'"
        
        from δ'_1 validESi have "e  set ?L. e  EESi"
          by (simp add: ES_valid_def traces_contain_events_def)
        hence "set δ'  EESi"
          by auto
        thus ?thesis
          by (simp add: list_subset_iff_projection_neutral)
      qed
      with δ'_1  have "?L1 @ δ' = (β @ γ @ δ')  EESi"
        by (simp only: projection_concatenation_commute, auto)
      with γ_is_cγ' δ'_1  show ?thesis
        by auto
    qed
    moreover
    note Suc(5)
    moreover note Suc(1)[of c "γ' @ δ'" β]
    ultimately obtain α_i'
      where α_i'_1: "β  EESi @ α_i'  TrESi"
      and α_i'_2: "α_i'  V𝒱i = (γ' @ δ')  V𝒱i"
      and α_i'_3: "α_i'  C𝒱i = []"
      by auto
    moreover
    have "α_i'  V𝒱i = α  V𝒱i"
    proof -
      have "α  V𝒱i = (γ' @ δ)  V𝒱i"
      proof -
        from cα_is_γc_iδ γ_is_cγ' have "α  V𝒱i = (γ' @ [c_i] @ δ)  V𝒱i"
          by simp
        with validVi c_i_in_C𝒱i show ?thesis
          by (simp only: isViewOn_def V_valid_def  VC_disjoint_def
            VN_disjoint_def NC_disjoint_def projection_concatenation_commute 
            projection_def, auto)
      qed
      moreover
      from α_i'_2 δ'_2' have "α_i'  V𝒱i = (γ' @ δ)  V𝒱i"
        by (simp only: projection_concatenation_commute)
      ultimately show ?thesis
        by auto
    qed
    ultimately show ?thesis
      by auto
  qed
qed

(*
    Variant of the previous lemma with different propositions (note the lack of a confidential event c).
*)
lemma BSD_in_subsystem2:
" ((β @ α)  EESi)  TrESi ; BSD 𝒱i TrESi  
    α_i'. ( ((β  EESi) @ α_i')  TrESi  (α_i'  V𝒱i) = (α  V𝒱i)  α_i'  C𝒱i = [] )"
proof (induct "length (α  C𝒱i)" arbitrary: β α)
  case 0
  (* show that α ↿ EESi  is a suitable choice for α_i' *)
  let ?L = "α  EESi"
  
  from 0(2) have β_E1_α_E1_in_Tr1: "((β  EESi) @ ?L)  TrESi"
    by (simp only: projection_concatenation_commute)
  moreover
  have "(?L  V𝒱i) = (α  V𝒱i)"
    proof -
      from validVi have "EESi  V𝒱i = V𝒱i"
        by (simp add: isViewOn_def V_valid_def  VC_disjoint_def
        VN_disjoint_def NC_disjoint_def, auto)
      moreover
      have "(?L  V𝒱i) = α  (EESi  V𝒱i)"
        by (simp add: projection_def)
      ultimately show ?thesis
        by auto
    qed
  moreover
  have "?L  C𝒱i = []"
  proof -
    from 0(1) have "α  C𝒱i = []"
      by auto
    hence "α  (C𝒱i  EESi) = []"
      by (rule projection_on_intersection)
    hence "α  (EESi  C𝒱i) = []"
      by (simp only: Int_commute)
    thus ?thesis
      by (simp only: projection_def, auto)                
  qed
  ultimately show ?case
    by auto
  
next
  case (Suc n)
  
  from projection_split_last[OF Suc(2)] obtain γ c_i δ
    where c_i_in_C𝒱i: "c_i  C𝒱i"
    and   α_is_γc_iδ: "α = γ @ [c_i] @ δ"
    and   δ_no_C𝒱i:  "δ  C𝒱i = []"
    and   n_is_len_γδ_C𝒱i: "n = length ((γ @ δ)  C𝒱i)"
    by auto
  
  let ?L1 = "((β @ γ)  EESi)"
  let ?L2 = "(δ  EESi)"


  (* first apply BSD to get rid of c_i in α *)
  note c_i_in_C𝒱i
  moreover
  have list_with_c_i_in_Tr1: "(?L1 @ [c_i] @ ?L2)  TrESi"
  proof -
    from c_i_in_C𝒱i validVi have "[c_i]  EESi = [c_i]"
      by (simp only: isViewOn_def V_valid_def  VC_disjoint_def
        VN_disjoint_def NC_disjoint_def projection_def, auto)
    moreover
    from Suc(3) α_is_γc_iδ have "((β @ γ @ [c_i] @ δ)  EESi)  TrESi"
      by auto
    hence "(?L1 @ ([c_i]  EESi) @ ?L2)  TrESi"
      by (simp only: projection_def, auto)
    ultimately show ?thesis
      by auto
  qed
  moreover 
  have "?L2  C𝒱i = []"
  proof -
    from validVi have "x. (x  EESi  x  C𝒱i) = (x  C𝒱i)"
      by (simp add: isViewOn_def V_valid_def  VC_disjoint_def
        VN_disjoint_def NC_disjoint_def, auto)
    with δ_no_C𝒱i show ?thesis
      by (simp add: projection_def)
  qed            
  moreover note Suc(4)
  ultimately obtain δ'
    where δ'_1: "(?L1 @ δ')  TrESi"
    and δ'_2: "δ'  V𝒱i = ?L2  V𝒱i"
    and δ'_3: "δ'  C𝒱i = []"
    unfolding BSD_def
    by blast
  hence δ'_2': "δ'  V𝒱i = δ  V𝒱i"
  proof -
    have "?L2  V𝒱i = δ  V𝒱i"
    proof -
      from validVi have "x. (x  EESi  x  V𝒱i) = (x  V𝒱i)"
        by (simp add: isViewOn_def V_valid_def  VC_disjoint_def
        VN_disjoint_def NC_disjoint_def, auto)
      thus ?thesis
        by (simp add: projection_def)
    qed
    with δ'_2 show ?thesis
      by auto
  qed

  (* now that we eliminated c_i, we can apply the inductive hypothesis for ?β = β and ?α = γ @ δ' *)
  from n_is_len_γδ_C𝒱i δ_no_C𝒱i δ'_3 have "n = length ((γ @ δ')  C𝒱i)"
    by (simp add: projection_concatenation_commute)
  moreover
  have "(β @ (γ @ δ'))  EESi  TrESi"
    proof -
      have "δ' = δ'  EESi"
        proof -
          let ?L = "(β @ γ)  EESi @ δ'"
        
          from δ'_1 validESi have "e  set ?L. e  EESi"
            by (simp add: ES_valid_def traces_contain_events_def)
          hence "set δ'  EESi"
            by auto
          thus ?thesis
            by (simp add: list_subset_iff_projection_neutral)
        qed
      with δ'_1  have "?L1 @ δ' = (β @ γ @ δ')  EESi"
        by (simp only: projection_concatenation_commute, auto)
      with δ'_1  show ?thesis
        by auto
    qed
  moreover
  note Suc(4) Suc(1)[of "γ @ δ'" β] 
  ultimately obtain α_i' 
    where res1: "β  EESi @ α_i'  TrESi" 
    and res2: "α_i'  V𝒱i = (γ @ δ')  V𝒱i"
    and res3: "α_i'  C𝒱i = []"
    by auto

  (* Show that the resulting α_i' is suitable *)
  have "α_i'  V𝒱i = α  V𝒱i"
    proof -
      from c_i_in_C𝒱i validVi have "[c_i]  V𝒱i = []"
        by (simp add: isViewOn_def V_valid_def  VC_disjoint_def
        VN_disjoint_def NC_disjoint_def projection_def, auto)
      with α_is_γc_iδ δ'_2' have "α  V𝒱i = (γ @ δ')  V𝒱i"
        by (simp only: projection_concatenation_commute, auto)
      with res2 show ?thesis
        by auto
    qed
  with res1 res3 show ?case
    by auto
qed

end

end

Theory GeneralizedZippingLemma

theory GeneralizedZippingLemma
imports CompositionBase
begin

context Compositionality
begin

(* The proof of the generalized zipping lemma is split into parts
  generalized_zipping_lemma1 .. generalized_zipping_lemma4
  corresponding to the four cases of well behaved composition.
    
Afterwards the actual lemma is proved based on these four parts. *)
 
(* Generalized zipping lemma for case one of lemma 6.4.4 *)
lemma generalized_zipping_lemma1: " N𝒱1  EES2 = {}; N𝒱2  EES1 = {}   
   τ lambda t1 t2. ( ( set τ  E(ES1  ES2)  set lambda  V𝒱  set t1  EES1  set t2  EES2
   ((τ  EES1) @ t1)  TrES1  ((τ  EES2) @ t2)  TrES2  (lambda  EES1) = (t1  V𝒱)
   (lambda  EES2) = (t2  V𝒱)  (t1  C𝒱1) = []  (t2  C𝒱2) = []) 
   ( t. ((τ @ t)  Tr(ES1  ES2)  (t  V𝒱) = lambda  (t  C𝒱) = [])) )"
proof -
  assume Nv1_inter_E2_empty: "N𝒱1  EES2 = {}"
    and Nv2_inter_E1_empty: "N𝒱2  EES1 = {}"

  {
    fix τ lambda t1 t2
    assume τ_in_Estar: "set τ  E(ES1  ES2)"
      and lambda_in_Vvstar: "set lambda  V𝒱"
      and t1_in_E1star: "set t1  EES1"
      and t2_in_E2star: "set t2  EES2"
      and τ_E1_t1_in_Tr1: "((τ  EES1) @ t1)  TrES1"
      and τ_E2_t2_in_Tr2: "((τ  EES2) @ t2)  TrES2"
      and lambda_E1_is_t1_Vv: "(lambda  EES1) = (t1  V𝒱)"
      and lambda_E2_is_t2_Vv: "(lambda  EES2) = (t2  V𝒱)"
      and t1_no_Cv1: "(t1  C𝒱1) = []"
      and t2_no_Cv2: "(t2  C𝒱2) = []"
   
     have " set τ  E(ES1  ES2);
      set lambda  V𝒱; 
      set t1  EES1;
      set t2  EES2;
      ((τ  EES1) @ t1)  TrES1;
      ((τ  EES2) @ t2)  TrES2;
      (lambda  EES1) = (t1  V𝒱);
      (lambda  EES2) = (t2  V𝒱);
      (t1  C𝒱1) = [];
      (t2  C𝒱2) = []   
       ( t. ((τ @ t)  Tr(ES1  ES2)  (t  V𝒱) = lambda  (t  C𝒱) = []))"
      proof (induct lambda arbitrary: τ t1 t2)
        case (Nil τ t1 t2)
        
        have "(τ @ [])  Tr(ES1  ES2)"
          proof -
            have "τ  Tr(ES1  ES2)"
              proof -
                from Nil(5) validES1 have "τ  EES1  TrES1"
                  by (simp add: ES_valid_def traces_prefixclosed_def 
                    prefixclosed_def prefix_def)
                moreover
                from Nil(6) validES2 have "τ  EES2  TrES2"
                  by (simp add: ES_valid_def traces_prefixclosed_def
                    prefixclosed_def prefix_def)
                moreover 
                note Nil(1)
                ultimately show ?thesis
                  by (simp add: composeES_def)
              qed
            thus ?thesis
              by auto
          qed
        moreover
        have "([]  V𝒱) = []"
          by (simp add: projection_def)
        moreover
        have "([]  C𝒱) = []"
          by (simp add: projection_def)
        ultimately show ?case
          by blast
      next
        case (Cons 𝒱' lambda' τ t1 t2) 
        thus ?case
          proof -
            from Cons(3) have v'_in_Vv: "𝒱'  V𝒱"
              by auto

            have "𝒱'  V𝒱1  V𝒱2 
               𝒱'  V𝒱1 - EES2
               𝒱'  V𝒱2 - EES1"  
              using Vv_is_Vv1_union_Vv2 v'_in_Vv  propSepViews
              unfolding properSeparationOfViews_def 
              by fastforce
            moreover {
              assume v'_in_Vv1_inter_Vv2: "𝒱'  V𝒱1  V𝒱2"
              hence v'_in_Vv1: "𝒱'  V𝒱1" and v'_in_Vv2: "𝒱'  V𝒱2" 
                by auto
              with v'_in_Vv propSepViews 
              have v'_in_E1: "𝒱'  EES1" and v'_in_E2: "𝒱'  EES2"
                unfolding properSeparationOfViews_def by auto
          
              (* split t1, t2 w. r. t. 𝒱' *)
              from Cons(2,4,8) v'_in_E1 have "t1  V𝒱 = 𝒱' # (lambda'  EES1)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r1 s1 
                where t1_is_r1_v'_s1: "t1 = r1 @ [𝒱'] @ s1"
                and r1_Vv_empty: "r1  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱1" "V𝒱" "r1"]
              have r1_Vv1_empty: "r1  V𝒱1 = []"
                by auto

              from Cons(3,5,9) v'_in_E2 have "t2  V𝒱 = 𝒱' # (lambda'  EES2)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r2 s2 
                where t2_is_r2_v'_s2: "t2 = r2 @ [𝒱'] @ s2"
                and r2_Vv_empty: "r2  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱2" "V𝒱" "r2"]
              have r2_Vv2_empty: "r2  V𝒱2 = []"
                by auto

              (* properties of r1, s1 *)
              from t1_is_r1_v'_s1 Cons(10) have r1_Cv1_empty: "r1  C𝒱1 = []"
                by (simp add: projection_concatenation_commute)

              from t1_is_r1_v'_s1 Cons(10) have s1_Cv1_empty: "s1  C𝒱1 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(4) t1_is_r1_v'_s1 have r1_in_E1star: "set r1  EES1" 
                and s1_in_E1star: "set s1  EES1"
                by auto

              from Cons(6) t1_is_r1_v'_s1 
              have τE1_r1_v'_s1_in_Tr1: "τ  EES1 @ r1 @ [𝒱'] @ s1  TrES1"
                by simp

              have r1_in_Nv1star: "set r1  N𝒱1"
                proof -
                  note r1_in_E1star
                  moreover
                  from r1_Vv1_empty have "set r1  V𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Diff_eq Int_commute 
                      Int_empty_right disjoint_eq_subset_Compl 
                      list_subset_iff_projection_neutral projection_on_union)
                  moreover
                  from r1_Cv1_empty have "set r1  C𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Diff_eq  Int_commute 
                      Int_empty_right disjoint_eq_subset_Compl 
                      list_subset_iff_projection_neutral projection_on_union)
                  moreover
                  note validV1
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def VN_disjoint_def NC_disjoint_def, auto)
                qed
              with Nv1_inter_E2_empty have r1E2_empty: "r1  EES2 = []"
                by (metis Int_commute empty_subsetI projection_on_subset2 r1_Vv_empty)                

              (* properties of r2, s2 *)
              from t2_is_r2_v'_s2 Cons(11) have r2_Cv2_empty: "r2  C𝒱2 = []"
                by (simp add: projection_concatenation_commute)

              from t2_is_r2_v'_s2 Cons(11) have s2_Cv2_empty: "s2  C𝒱2 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(5) t2_is_r2_v'_s2 have r2_in_E2star: "set r2  EES2" 
                and s2_in_E2star: "set s2  EES2"
                by auto

              from Cons(7) t2_is_r2_v'_s2 
              have τE2_r2_v'_s2_in_Tr2: "τ  EES2 @ r2 @ [𝒱'] @ s2  TrES2"
                by simp

              have r2_in_Nv2star: "set r2  N𝒱2"
                proof -
                  note r2_in_E2star
                  moreover
                  from r2_Vv2_empty have "set r2  V𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  from r2_Cv2_empty have "set r2  C𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  note validV2
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def VN_disjoint_def NC_disjoint_def, auto)
                qed
              with Nv2_inter_E1_empty have r2E1_empty: "r2  EES1 = []"
                by (metis Int_commute empty_subsetI projection_on_subset2 r2_Vv_empty)          
                            
              (* apply inductive hypothesis to lambda' s1 s2 *)
              let ?tau = "τ @ r1 @ r2 @ [𝒱']"

              from Cons(2) r1_in_E1star r2_in_E2star v'_in_E2 
              have "set ?tau  (E(ES1  ES2))"
                by (simp add: composeES_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              note s1_in_E1star s2_in_E2star
              moreover
              from Cons(6) r1_in_E1star r2E1_empty v'_in_E1 t1_is_r1_v'_s1 
              have "((?tau  EES1) @ s1)  TrES1"
                by (simp only: projection_concatenation_commute 
                  list_subset_iff_projection_neutral projection_def, auto)
              moreover
              from Cons(7) r2_in_E2star r1E2_empty v'_in_E2 t2_is_r2_v'_s2 
              have "((?tau  EES2) @ s2)  TrES2"
                by (simp only: projection_concatenation_commute 
                  list_subset_iff_projection_neutral projection_def, auto)
              moreover
              have "lambda'  EES1 = s1  V𝒱"
                proof -
                  from Cons(2,4,8) v'_in_E1 have "t1  V𝒱 = [𝒱'] @ (lambda'  EES1)"
                    by (simp add: projection_def)
                  moreover
                  from t1_is_r1_v'_s1 r1_Vv_empty v'_in_Vv1 Vv_is_Vv1_union_Vv2 
                  have "t1  V𝒱 = [𝒱'] @ (s1  V𝒱)"
                    by (simp only: t1_is_r1_v'_s1 projection_concatenation_commute 
                      projection_def, auto)
                  ultimately show ?thesis
                    by auto
                qed
              moreover
              have "lambda'  EES2 = s2  V𝒱"
                proof -
                  from Cons(3,5,9) v'_in_E2 have "t2  V𝒱 = [𝒱'] @ (lambda'  EES2)"
                    by (simp add: projection_def)
                  moreover
                  from t2_is_r2_v'_s2 r2_Vv_empty v'_in_Vv2 Vv_is_Vv1_union_Vv2 
                  have "t2  V𝒱 = [𝒱'] @ (s2  V𝒱)"
                    by (simp only: t2_is_r2_v'_s2 projection_concatenation_commute 
                      projection_def, auto)
                  ultimately show ?thesis
                    by auto
                qed
              moreover
              note s1_Cv1_empty s2_Cv2_empty Cons.hyps(1)[of ?tau s1 s2]
              ultimately obtain t'
                where tau_t'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'Cv_empty: "t'  C𝒱 = []"
                by auto

              let ?t = "r1 @ r2 @ [𝒱'] @ t'"

              (* conclude that ?t is a suitable choice *)              
              note tau_t'_in_Tr
              moreover
              from r1_Vv_empty r2_Vv_empty t'Vv_is_lambda' v'_in_Vv 
              have "?t  V𝒱 = 𝒱' # lambda'"
                by (simp add: projection_def)
              moreover
              have "?t  C𝒱 = []"
              proof -
                from propSepViews have "C𝒱  EES1  C𝒱1"
                  unfolding properSeparationOfViews_def by auto
                hence "r1  C𝒱 = []"                 
                    by (metis  projection_on_subset2  r1_Cv1_empty r1_in_E1star)
                  moreover
                from propSepViews have "C𝒱  EES2  C𝒱2"
                  unfolding properSeparationOfViews_def by auto
                hence "r2  C𝒱 = []"
                    by (metis  projection_on_subset2 r2_Cv2_empty r2_in_E2star)
                  moreover
                  note v'_in_Vv VIsViewOnE t'Cv_empty 
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def VC_disjoint_def projection_def, auto)
                qed
              ultimately have ?thesis 
                by auto
            }
            moreover {
              assume v'_in_Vv1_minus_E2: "𝒱'  V𝒱1 - EES2"
              hence v'_in_Vv1: "𝒱'  V𝒱1"
                by auto
              with v'_in_Vv propSepViews have v'_in_E1: "𝒱'  EES1"
                unfolding properSeparationOfViews_def
                by auto

              from v'_in_Vv1_minus_E2 have v'_notin_E2: "𝒱'  EES2"
                by (auto)
              with validV2 have v'_notin_Vv2: "𝒱'  V𝒱2"
                by (simp add: isViewOn_def V_valid_def, auto)

               (* split t1 w.r.t. 𝒱' *)
              from Cons(3) Cons(4) Cons(8) v'_in_E1 have "t1  V𝒱 = 𝒱' # (lambda'  EES1)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r1 s1 
                where t1_is_r1_v'_s1: "t1 = r1 @ [𝒱'] @ s1"
                and r1_Vv_empty: "r1  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱1" "V𝒱" "r1"]
              have r1_Vv1_empty: "r1  V𝒱1 = []"
                by auto
              
              (* properties of r1 s1 *)
              from t1_is_r1_v'_s1 Cons(10) have r1_Cv1_empty: "r1  C𝒱1 = []"
                by (simp add: projection_concatenation_commute)

              from t1_is_r1_v'_s1 Cons(10) have s1_Cv1_empty: "s1  C𝒱1 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(4) t1_is_r1_v'_s1 have r1_in_E1star: "set r1  EES1"
                by auto

              have r1_in_Nv1star: "set r1  N𝒱1"
              proof -
                note r1_in_E1star
                moreover
                from r1_Vv1_empty have "set r1  V𝒱1 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Diff_eq  Int_commute 
                    Int_empty_right disjoint_eq_subset_Compl 
                    list_subset_iff_projection_neutral projection_on_union)
                moreover
                from r1_Cv1_empty have "set r1  C𝒱1 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Diff_eq  Int_commute 
                    Int_empty_right disjoint_eq_subset_Compl 
                    list_subset_iff_projection_neutral projection_on_union)
                moreover
                note validV1
                ultimately show ?thesis
                  by (simp add: isViewOn_def V_valid_def VN_disjoint_def NC_disjoint_def, auto)
              qed
              with Nv1_inter_E2_empty have r1E2_empty: "r1  EES2 = []"               
                by (metis Int_commute empty_subsetI 
                  projection_on_subset2 r1_Vv1_empty)
             
              (* apply inductive hypothesis to lambda' r1 t2 *)
              let ?tau = "τ @ r1 @ [𝒱']"
              
              from v'_in_E1 Cons(2) r1_in_Nv1star validV1 
              have "set ?tau  E(ES1  ES2)"
                by (simp only: isViewOn_def composeES_def V_valid_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              from Cons(4) t1_is_r1_v'_s1 have "set s1  EES1"
                by auto
              moreover
              note Cons(5)
              moreover
              have "?tau  EES1 @ s1  TrES1"
                by (metis Cons_eq_appendI append_eq_appendI calculation(3) eq_Nil_appendI 
                  list_subset_iff_projection_neutral Cons.prems(3) Cons.prems(5) 
                  projection_concatenation_commute t1_is_r1_v'_s1)
              moreover
              have "?tau  EES2 @ t2  TrES2"
                proof -
                  from v'_notin_E2 have "[𝒱']  EES2 = []"
                    by (simp add: projection_def)
                  with Cons(7) Cons(4) t1_is_r1_v'_s1 v'_notin_E2 
                    r1_in_Nv1star Nv1_inter_E2_empty r1E2_empty
                    show ?thesis
                      by (simp only: t1_is_r1_v'_s1 list_subset_iff_projection_neutral 
                        projection_concatenation_commute, auto)
                qed
              moreover
              from Cons(8) t1_is_r1_v'_s1 r1_Vv_empty v'_in_E1 v'_in_Vv have "lambda'  EES1 = s1  V𝒱"
                by (simp add: projection_def)
              moreover
              from Cons(9) v'_notin_E2 have "lambda'  EES2 = t2  V𝒱"         
                by (simp add: projection_def)
              moreover
              note s1_Cv1_empty Cons(11)
              moreover
              note Cons.hyps(1)[of ?tau s1 t2]
              ultimately obtain t'
                where tau_t'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'_Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'_Cv_empty: "t'  C𝒱 = []"
                by auto

              let ?t = "r1 @ [𝒱'] @ t'"

              (* conclude that ?t is a suitable choice *)      
              note tau_t'_in_Tr
              moreover
              from r1_Vv_empty t'_Vv_is_lambda' v'_in_Vv 
              have "?t  V𝒱 = 𝒱' # lambda'"
                by (simp add: projection_def)
              moreover
              have "?t  C𝒱 = []"
              proof -
                from propSepViews have "C𝒱  EES1  C𝒱1"
                  unfolding properSeparationOfViews_def by auto
                hence"r1  C𝒱 = []"                 
                  by (metis projection_on_subset2 r1_Cv1_empty r1_in_E1star)
                with v'_in_Vv VIsViewOnE t'_Cv_empty show ?thesis
                  by (simp add: isViewOn_def V_valid_def VC_disjoint_def projection_def, auto)
              qed
              ultimately have ?thesis
                by auto
            }
            moreover {
              assume v'_in_Vv2_minus_E1: "𝒱'  V𝒱2 - EES1"
              hence v'_in_Vv2: "𝒱'  V𝒱2"
                by auto
              with v'_in_Vv propSepViews 
              have v'_in_E2: "𝒱'  EES2"
                unfolding properSeparationOfViews_def by auto

              from v'_in_Vv2_minus_E1 
              have v'_notin_E1: "𝒱'  EES1"
                by (auto)
              with validV1 
              have v'_notin_Vv1: "𝒱'  V𝒱1"
                by (simp add:isViewOn_def V_valid_def, auto)

               (* split t2 w.r.t. 𝒱' *)
              from Cons(4) Cons(5) Cons(9) v'_in_E2 
              have "t2  V𝒱 = 𝒱' # (lambda'  EES2)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r2 s2 
                where t2_is_r2_v'_s2: "t2 = r2 @ [𝒱'] @ s2"
                and r2_Vv_empty: "r2  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱2" "V𝒱" "r2"]
              have r2_Vv2_empty: "r2  V𝒱2 = []"
                by auto
              
              (* properties of r2 s2 *)
              from t2_is_r2_v'_s2 Cons(11) have r2_Cv2_empty: "r2  C𝒱2 = []"
                by (simp add: projection_concatenation_commute)

              from t2_is_r2_v'_s2 Cons(11) have s2_Cv2_empty: "s2  C𝒱2 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(5) t2_is_r2_v'_s2 have r2_in_E2star: "set r2  EES2"
                by auto

              have r2_in_Nv2star: "set r2  N𝒱2"
              proof -
                note r2_in_E2star
                moreover
                from r2_Vv2_empty have "set r2  V𝒱2 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                    disjoint_eq_subset_Compl 
                    list_subset_iff_projection_neutral projection_on_union)
                moreover
                from r2_Cv2_empty have "set r2  C𝒱2 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                    disjoint_eq_subset_Compl 
                    list_subset_iff_projection_neutral projection_on_union)
                moreover
                note validV2
                ultimately show ?thesis
                  by (simp add: isViewOn_def V_valid_def VN_disjoint_def NC_disjoint_def, auto)
              qed
              with Nv2_inter_E1_empty have r2E1_empty: "r2  EES1 = []"               
                by (metis Int_commute empty_subsetI 
                  projection_on_subset2 r2_Vv2_empty)
             
              (* apply inductive hypothesis to lambda' t1 r2 *)
              let ?tau = "τ @ r2 @ [𝒱']"
              
              from v'_in_E2 Cons(2) r2_in_Nv2star validV2 
              have "set ?tau  E(ES1  ES2)"
                by (simp only: composeES_def isViewOn_def V_valid_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              note Cons(4)
              moreover
              from Cons(5) t2_is_r2_v'_s2 have "set s2  EES2"
                by auto
              moreover
              have "?tau  EES1 @ t1  TrES1"
                proof -
                  from v'_notin_E1 have "[𝒱']  EES1 = []"
                    by (simp add: projection_def)
                  with Cons(6) Cons(3) t2_is_r2_v'_s2 v'_notin_E1 r2_in_Nv2star 
                    Nv2_inter_E1_empty r2E1_empty
                    show ?thesis
                      by (simp only: t2_is_r2_v'_s2 list_subset_iff_projection_neutral 
                        projection_concatenation_commute, auto)
                qed
              moreover
              have "?tau  EES2 @ s2  TrES2"              
                by (metis Cons_eq_appendI append_eq_appendI calculation(4) eq_Nil_appendI 
                  list_subset_iff_projection_neutral Cons.prems(4) Cons.prems(6) 
                  projection_concatenation_commute t2_is_r2_v'_s2)
              moreover
              from Cons(8) v'_notin_E1 have "lambda'  EES1 = t1  V𝒱"         
                by (simp add: projection_def)
              moreover
              from Cons(9) t2_is_r2_v'_s2 r2_Vv_empty v'_in_E2 v'_in_Vv 
              have "lambda'  EES2 = s2  V𝒱"
                by (simp add: projection_def)
              moreover
              note Cons(10) s2_Cv2_empty
              moreover
              note Cons.hyps(1)[of ?tau t1 s2]
              ultimately obtain t'
                where tau_t'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'_Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'_Cv_empty: "t'  C𝒱 = []"
                by auto

              let ?t = "r2 @ [𝒱'] @ t'"

              (* conclude that ?t is a suitable choice *)      
              note tau_t'_in_Tr
              moreover
              from r2_Vv_empty t'_Vv_is_lambda' v'_in_Vv 
              have "?t  V𝒱 = 𝒱' # lambda'"
                by (simp add: projection_def)
              moreover
              have "?t  C𝒱 = []"
              proof -
                from propSepViews have "C𝒱  EES2  C𝒱2"
                  unfolding properSeparationOfViews_def by auto
                hence "r2  C𝒱 = []"                 
                  by (metis projection_on_subset2 r2_Cv2_empty r2_in_E2star)
                with v'_in_Vv VIsViewOnE t'_Cv_empty show ?thesis
                  by (simp add: isViewOn_def V_valid_def VC_disjoint_def projection_def, auto)
              qed
              ultimately have ?thesis
                by auto
            }
            ultimately show ?thesis
              by blast
          qed
        qed
  }
  thus ?thesis 
    by auto
qed

 (* Generalized zipping lemma for case two of lemma 6.4.4 *)
lemma generalized_zipping_lemma2: " N𝒱1  EES2 = {}; total ES1 (C𝒱1  N𝒱2); BSIA ρ1 𝒱1 TrES1   
   τ lambda t1 t2. ( ( set τ  (E(ES1  ES2))  set lambda  V𝒱  set t1  EES1  set t2  EES2
   ((τ  EES1) @ t1)  TrES1  ((τ  EES2) @ t2)  TrES2
   (lambda  EES1) = (t1  V𝒱)  (lambda  EES2) = (t2  V𝒱)
   (t1  C𝒱1) = []  (t2  C𝒱2) = []) 
   ( t. ((τ @ t)  (Tr(ES1  ES2))  (t  V𝒱) = lambda  (t  C𝒱) = [])) )"
proof -
  assume Nv1_inter_E2_empty: "N𝒱1  EES2 = {}"
  assume total_ES1_Cv1_inter_Nv2: "total ES1 (C𝒱1  N𝒱2)"
  assume BSIA: "BSIA ρ1 𝒱1 TrES1"

  {
    fix τ lambda t1 t2
    assume τ_in_Estar: "set τ  E(ES1  ES2)"
      and lambda_in_Vvstar: "set lambda  V𝒱"
      and t1_in_E1star: "set t1  EES1"
      and t2_in_E2star: "set t2  EES2"
      and τ_E1_t1_in_Tr1: "((τ  EES1) @ t1)  TrES1"
      and τ_E2_t2_in_Tr2: "((τ  EES2) @ t2)  TrES2"
      and lambda_E1_is_t1_Vv: "(lambda  EES1) = (t1  V𝒱)"
      and lambda_E2_is_t2_Vv: "(lambda  EES2) = (t2  V𝒱)"
      and t1_no_Cv1: "(t1  C𝒱1) = []"
      and t2_no_Cv2: "(t2  C𝒱2) = []"

      have " set τ  E(ES1  ES2); set lambda  V𝒱; 
        set t1  EES1; set t2  EES2;
      ((τ  EES1) @ t1)  TrES1; ((τ  EES2) @ t2)  TrES2;
      (lambda  EES1) = (t1  V𝒱); (lambda  EES2) = (t2  V𝒱);
      (t1  C𝒱1) = []; (t2  C𝒱2) = []   
       (t. ((τ @ t)  Tr(ES1  ES2)  (t  V𝒱) = lambda  (t  C𝒱) = []))"
      proof (induct lambda arbitrary: τ t1 t2)
        case (Nil τ t1 t2)
        
        have "(τ @ [])  Tr(ES1  ES2)"
          proof -
            have "τ  Tr(ES1  ES2)"
              proof -
                from Nil(5) validES1 have "τ  EES1  TrES1"
                  by (simp add: ES_valid_def traces_prefixclosed_def 
                    prefixclosed_def prefix_def)
                moreover
                from Nil(6) validES2 have "τ  EES2  TrES2"
                  by (simp add: ES_valid_def traces_prefixclosed_def
                    prefixclosed_def prefix_def)
                moreover 
                note Nil(1)
                ultimately show ?thesis
                  by (simp add: composeES_def)
              qed
            thus ?thesis
              by auto
          qed
        moreover
        have "([]  V𝒱) = []"
          by (simp add: projection_def)
        moreover
        have "([]  C𝒱) = []"
          by (simp add: projection_def)
        ultimately show ?case
          by blast
      next
        case (Cons 𝒱' lambda' τ t1 t2) 
        thus ?case
          proof -
            from Cons(3) have v'_in_Vv: "𝒱'  V𝒱"
              by auto

            have "𝒱'  V𝒱1  V𝒱2  𝒱'  V𝒱1 - EES2  𝒱'  V𝒱2 - EES1" 
              using propSepViews unfolding properSeparationOfViews_def 
              using Vv_is_Vv1_union_Vv2 v'_in_Vv by fastforce
            moreover {
              assume v'_in_Vv1_inter_Vv2: "𝒱'  V𝒱1  V𝒱2"
              hence v'_in_Vv1: "𝒱'  V𝒱1" and v'_in_Vv2: "𝒱'  V𝒱2" 
                by auto
              with v'_in_Vv propSepViews
              have v'_in_E1: "𝒱'  EES1" and v'_in_E2: "𝒱'  EES2"
                unfolding properSeparationOfViews_def by auto

              (* split t2 w.r.t. 𝒱' *)
              from Cons(3,5,9) v'_in_E2 
              have "t2  V𝒱 = 𝒱' # (lambda'  EES2)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r2 s2 
                where t2_is_r2_v'_s2: "t2 = r2 @ [𝒱'] @ s2"
                and r2_Vv_empty: "r2  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱2" "V𝒱" "r2"]
              have r2_Vv2_empty: "r2  V𝒱2 = []"
                by auto

              (* properties of r2 s2 *)
              from t2_is_r2_v'_s2 Cons(11) have r2_Cv2_empty: "r2  C𝒱2 = []"
                by (simp add: projection_concatenation_commute)

              from t2_is_r2_v'_s2 Cons(11) have s2_Cv2_empty: "s2  C𝒱2 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(5) t2_is_r2_v'_s2 have r2_in_E2star: "set r2  EES2" 
                and s2_in_E2star: "set s2  EES2"
                by auto

              from Cons(7) t2_is_r2_v'_s2 
              have τE2_r2_v'_s2_in_Tr2: "τ  EES2 @ r2 @ [𝒱'] @ s2  TrES2"
                by simp

              have r2_in_Nv2star: "set r2  N𝒱2"
                proof -
                  note r2_in_E2star
                  moreover
                  from r2_Vv2_empty have "set r2  V𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  from r2_Cv2_empty have "set r2  C𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  note validV2
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def VN_disjoint_def NC_disjoint_def, auto)
                qed
              
              have r2E1_in_Nv2_inter_C1_star: "set (r2  EES1)  (N𝒱2  C𝒱1)"
                proof -
                  have "set (r2  EES1) = set r2  EES1"
                    by (simp add: projection_def, auto)
                  with r2_in_Nv2star have "set (r2  EES1)  (EES1  N𝒱2)"
                    by auto
                  moreover 
                  from validV1 propSepViews 
                  have "EES1  N𝒱2 = N𝒱2  C𝒱1"
                    unfolding properSeparationOfViews_def isViewOn_def V_valid_def 
                    using disjoint_Nv2_Vv1 by blast
                  ultimately show ?thesis
                    by auto
                qed
 
              note outerCons_prems = Cons.prems

              (* repair t1 by inserting r2 ↿ EES1 *)
              have "set (r2  EES1)  (N𝒱2  C𝒱1)  
                 t1'. ( set t1'  EES1 
                 ((τ @ r2)  EES1) @ t1'  TrES1 
                 t1'  V𝒱1 = t1  V𝒱1 
                 t1'  C𝒱1 = [] )"
              proof (induct "r2  EES1" arbitrary: r2 rule: rev_induct)
                case Nil thus ?case     
                  by (metis append_self_conv outerCons_prems(9) 
                    outerCons_prems(3) outerCons_prems(5) projection_concatenation_commute)
              next
                case (snoc x xs)

                have xs_is_xsE1: "xs = xs  EES1"
                  proof -
                    from snoc(2) have "set (xs @ [x])  EES1"
                      by (simp add: projection_def, auto)
                    hence "set xs  EES1"
                      by auto
                    thus ?thesis
                      by (simp add: list_subset_iff_projection_neutral)
                  qed
                moreover
                have "set (xs  EES1)  (N𝒱2  C𝒱1)"
                  proof -
                    have "set (r2  EES1)  (N𝒱2  C𝒱1)"                      
                      by (metis Int_commute snoc.prems)
                    with snoc(2) have "set (xs @ [x])  (N𝒱2  C𝒱1)"
                      by simp
                    hence "set xs  (N𝒱2  C𝒱1)"
                      by auto
                    with xs_is_xsE1 show ?thesis
                      by auto
                  qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain t1''
                  where t1''_in_E1star: "set t1''  EES1"
                  and τ_xs_E1_t1''_in_Tr1: "((τ @ xs)  EES1) @ t1''  TrES1"
                  and t1''Vv1_is_t1Vv1: "t1''  V𝒱1 = t1  V𝒱1"
                  and t1''Cv1_empty: "t1''  C𝒱1 = []"
                  by auto
                              
                have x_in_Cv1_inter_Nv2: "x  C𝒱1  N𝒱2"
                  proof -
                    from snoc(2-3) have "set (xs @ [x])  (N𝒱2  C𝒱1)"
                      by simp
                    thus ?thesis
                      by auto
                  qed
                hence x_in_Cv1: "x  C𝒱1"
                  by auto
                moreover
                note τ_xs_E1_t1''_in_Tr1 t1''Cv1_empty
                moreover
                have Adm: "(Adm 𝒱1 ρ1 TrES1 ((τ @ xs)  EES1) x)"
                  proof -
                    from τ_xs_E1_t1''_in_Tr1 validES1 
                    have τ_xsE1_in_Tr1: "((τ @ xs)  EES1)  TrES1"
                      by (simp add: ES_valid_def traces_prefixclosed_def 
                        prefixclosed_def prefix_def)
                    with x_in_Cv1_inter_Nv2 total_ES1_Cv1_inter_Nv2 
                    have τ_xsE1_x_in_Tr1: "((τ @ xs)  EES1) @ [x]  TrES1"
                      by (simp only: total_def)
                    moreover
                    have "((τ @ xs)  EES1)  (ρ1 𝒱1) = ((τ @ xs)  EES1)  (ρ1 𝒱1)" ..
                    ultimately show ?thesis
                      by (simp add: Adm_def, auto)
                  qed
                moreover note BSIA
                ultimately obtain t1'
                  where res1: "((τ @ xs)  EES1) @ [x] @ t1'  TrES1"
                  and res2: "t1'  V𝒱1 = t1''  V𝒱1"
                  and res3: "t1'  C𝒱1 = []"
                  by (simp only: BSIA_def, blast)

                have "set t1'  EES1"
                  proof -
                    from res1 validES1 
                    have "set (((τ @ xs)  EES1) @ [x] @ t1')  EES1"
                      by (simp add: ES_valid_def traces_contain_events_def, auto)
                    thus ?thesis
                      by auto
                  qed
                moreover 
                have "((τ @ r2)  EES1) @ t1'  TrES1"
                  proof -
                    from res1 xs_is_xsE1 have "((τ  EES1) @ (xs @ [x])) @ t1'  TrES1"
                      by (simp only: projection_concatenation_commute, auto)
                    thus  ?thesis
                      by (simp only: snoc(2) projection_concatenation_commute)
                  qed
                moreover
                from t1''Vv1_is_t1Vv1 res2 have "t1'  V𝒱1 = t1  V𝒱1"
                  by auto
                moreover
                note res3
                ultimately show ?case
                  by auto
              qed
              from this[OF r2E1_in_Nv2_inter_C1_star] obtain t1'
                where t1'_in_E1star: "set t1'  EES1" 
                and τr2E1_t1'_in_Tr1: "((τ @ r2)  EES1) @ t1'  TrES1"
                and t1'_Vv1_is_t1_Vv1: "t1'  V𝒱1 = t1  V𝒱1"
                and t1'_Cv1_empty: "t1'  C𝒱1 = []"
                by auto

              (* split t1' w.r.t. 𝒱' *)
              have "t1'  V𝒱1 = 𝒱' # (lambda'  EES1)"
                proof -
                  from projection_intersection_neutral[OF Cons(4), of "V𝒱"] 
                  propSepViews
                  have "t1  V𝒱 = t1  V𝒱1" 
                    unfolding properSeparationOfViews_def
                    by (simp only: Int_commute)
                  with Cons(8) t1'_Vv1_is_t1_Vv1 v'_in_E1 show ?thesis
                    by (simp add: projection_def)
                qed
              from projection_split_first[OF this] obtain r1' s1'
                where t1'_is_r1'_v'_s1': "t1' = r1' @ [𝒱'] @ s1'"
                and r1'_Vv1_empty: "r1'  V𝒱1 = []"
                by auto
              
              (* properties of r1' s1' *)
              from t1'_is_r1'_v'_s1' t1'_Cv1_empty 
              have r1'_Cv1_empty: "r1'  C𝒱1 = []"
                by (simp add: projection_concatenation_commute)
              
              from t1'_is_r1'_v'_s1' t1'_Cv1_empty 
              have s1'_Cv1_empty: "s1'  C𝒱1 = []"
                by (simp only: projection_concatenation_commute, auto)
              
              from t1'_in_E1star t1'_is_r1'_v'_s1' 
              have r1'_in_E1star: "set r1'  EES1"
                by auto
              with propSepViews r1'_Vv1_empty 
              have r1'_Vv_empty: "r1'  V𝒱 = []"
                unfolding properSeparationOfViews_def
                by (metis projection_on_subset2 subset_iff_psubset_eq)

              have r1'_in_Nv1star: "set r1'  N𝒱1"
                proof - 
                  note r1'_in_E1star
                  moreover
                  from r1'_Vv1_empty have "set r1'  V𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  from r1'_Cv1_empty have "set r1'  C𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  note validV1
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def VN_disjoint_def NC_disjoint_def, auto)
                qed
              with Nv1_inter_E2_empty have r1'E2_empty: "r1'  EES2 = []"               
                by (metis Int_commute empty_subsetI 
                  projection_on_subset2 r1'_Vv1_empty)
              
              (* apply inductive hypothesis to lambda' s1' s2 *)
              let ?tau = "τ @ r2 @ r1' @ [𝒱']"
           
              from Cons(2) r2_in_E2star r1'_in_E1star v'_in_E2 
              have "set ?tau  (E(ES1  ES2))"
                by (simp add: composeES_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              from t1'_in_E1star t1'_is_r1'_v'_s1' 
              have "set s1'  EES1"
                by simp
              moreover
              note s2_in_E2star
              moreover
              from τr2E1_t1'_in_Tr1 t1'_is_r1'_v'_s1' v'_in_E1 
              have "?tau  EES1 @ s1'  TrES1"
                proof -
                  from v'_in_E1 r1'_in_E1star 
                  have  "(τ @ r2 @ r1' @ [𝒱'])  EES1 =  (τ @ r2)  EES1 @ r1' @ [𝒱']"
                    by (simp only: projection_concatenation_commute 
                      list_subset_iff_projection_neutral projection_def, auto)
                  with τr2E1_t1'_in_Tr1 t1'_is_r1'_v'_s1' v'_in_E1 show ?thesis
                    by simp
                qed
              moreover
              from r2_in_E2star v'_in_E2 r1'E2_empty τE2_r2_v'_s2_in_Tr2 
              have "?tau  EES2 @ s2  TrES2"
                by (simp only: list_subset_iff_projection_neutral
                  projection_concatenation_commute projection_def, auto)
              moreover
              have "lambda'  EES1 = s1'  V𝒱"
              proof -
                from Cons(2,4,8)  v'_in_E1 have "t1  V𝒱 = [𝒱'] @ (lambda'  EES1)"
                  by (simp add: projection_def)
                moreover            
                from t1'_is_r1'_v'_s1' r1'_Vv1_empty r1'_in_E1star v'_in_Vv1 propSepViews
                have "t1'  V𝒱 = [𝒱'] @ (s1'  V𝒱)"
                proof -
                  have "r1'  V𝒱 =[]" 
                    using propSepViews unfolding properSeparationOfViews_def
                    by (metis  projection_on_subset2 
                      r1'_Vv1_empty r1'_in_E1star subset_iff_psubset_eq)
                  with t1'_is_r1'_v'_s1' v'_in_Vv1 Vv_is_Vv1_union_Vv2 show ?thesis                    
                    by (simp only: t1'_is_r1'_v'_s1' projection_concatenation_commute 
                      projection_def, auto)
                qed
                moreover
                have "t1  V𝒱 = t1'  V𝒱" 
                  using propSepViews unfolding properSeparationOfViews_def
                  by (metis Int_commute  outerCons_prems(3) 
                    projection_intersection_neutral 
                    t1'_Vv1_is_t1_Vv1 t1'_in_E1star)
                ultimately show ?thesis
                  by auto
              qed
              moreover
              have "lambda'  EES2 = s2  V𝒱"
              proof -
                from Cons(3,5,9) v'_in_E2 have "t2  V𝒱 = [𝒱'] @ (lambda'  EES2)"
                  by (simp add: projection_def)
                moreover
                from t2_is_r2_v'_s2 r2_Vv_empty v'_in_Vv2 Vv_is_Vv1_union_Vv2 
                have "t2  V𝒱 = [𝒱'] @ (s2  V𝒱)"
                  by (simp only: t2_is_r2_v'_s2 projection_concatenation_commute projection_def, auto)
                ultimately show ?thesis
                  by auto
              qed
              moreover
              note s1'_Cv1_empty s2_Cv2_empty Cons.hyps[of ?tau s1' s2]
              ultimately obtain t'
                where tau_t'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'Cv_empty: "t'  C𝒱 = []"
                by auto
              
              let ?t = "r2 @ r1' @ [𝒱'] @ t'"

              (* conclude that ?t is a suitable choice *)
              note tau_t'_in_Tr
              moreover
              from r2_Vv_empty r1'_Vv_empty t'Vv_is_lambda' v'_in_Vv have "?t  V𝒱 = 𝒱' # lambda'"
                by(simp only: projection_concatenation_commute projection_def, auto)
              moreover
              from VIsViewOnE r2_Cv2_empty t'Cv_empty r1'_Cv1_empty v'_in_Vv 
              have "?t  C𝒱 = []"
              proof -
                from VIsViewOnE v'_in_Vv have "[𝒱']  C𝒱 = []"
                  by (simp add: isViewOn_def V_valid_def VC_disjoint_def projection_def, auto)
                moreover
                from r2_in_E2star r2_Cv2_empty propSepViews 
                have "r2  C𝒱 = []" 
                  unfolding properSeparationOfViews_def  
                  using projection_on_subset2 by auto
                moreover
                from r1'_in_E1star r1'_Cv1_empty propSepViews
                have "r1'  C𝒱 = []" 
                  unfolding properSeparationOfViews_def 
                  using projection_on_subset2 by auto
                moreover
                note t'Cv_empty
                ultimately show ?thesis
                  by (simp only: projection_concatenation_commute, auto)
              qed
              ultimately have ?thesis
                by auto
            }
            moreover {
              assume v'_in_Vv1_minus_E2: "𝒱'  V𝒱1 - EES2"
              hence v'_in_Vv1: "𝒱'  V𝒱1"
                by auto
              with v'_in_Vv propSepViews have v'_in_E1: "𝒱'  EES1"
                unfolding properSeparationOfViews_def by auto

              from v'_in_Vv1_minus_E2 have v'_notin_E2: "𝒱'  EES2"
                by (auto)
              with validV2 have v'_notin_Vv2: "𝒱'  V𝒱2"
                by (simp add: isViewOn_def V_valid_def, auto)

              (* split t1 w.r.t. v' *)
              from Cons(3) Cons(4) Cons(8) v'_in_E1 
              have "t1  V𝒱 = 𝒱' # (lambda'  EES1)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r1 s1 
                where t1_is_r1_v'_s1: "t1 = r1 @ [𝒱'] @ s1"
                and r1_Vv_empty: "r1  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱1" "V𝒱" "r1"]
              have r1_Vv1_empty: "r1  V𝒱1 = []"
                by auto

              (* properties of r1 s1 *)
              from t1_is_r1_v'_s1 Cons(10) 
              have r1_Cv1_empty: "r1  C𝒱1 = []"
                by (simp add: projection_concatenation_commute)

              from t1_is_r1_v'_s1 Cons(10) 
              have s1_Cv1_empty: "s1  C𝒱1 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(4) t1_is_r1_v'_s1 
              have r1_in_E1star: "set r1  EES1"
                by auto

              have r1_in_Nv1star: "set r1  N𝒱1"
              proof -
                note r1_in_E1star
                moreover
                from r1_Vv1_empty have "set r1  V𝒱1 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Diff_eq  
                    Int_commute Int_empty_right disjoint_eq_subset_Compl 
                    list_subset_iff_projection_neutral projection_on_union)
                moreover
                from r1_Cv1_empty have "set r1  C𝒱1 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Diff_eq 
                    Int_commute Int_empty_right disjoint_eq_subset_Compl 
                    list_subset_iff_projection_neutral projection_on_union)
                moreover
                note validV1
                ultimately show ?thesis
                  by (simp add: isViewOn_def V_valid_def VN_disjoint_def NC_disjoint_def, auto)
              qed
              with Nv1_inter_E2_empty have r1E2_empty: "r1  EES2 = []"               
                by (metis Int_commute empty_subsetI projection_on_subset2 r1_Vv1_empty)
             
             
              (* apply inductive hypothesis to lambda' s1 t2 *)
              let ?tau = "τ @ r1 @ [𝒱']"
              
              from v'_in_E1 Cons(2) r1_in_Nv1star validV1 
              have "set ?tau  E(ES1  ES2)"
                by (simp only: composeES_def isViewOn_def V_valid_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              from Cons(4) t1_is_r1_v'_s1 have "set s1  EES1"
                by auto
              moreover
              note Cons(5)
              moreover
              have "?tau  EES1 @ s1  TrES1"              
                by (metis Cons_eq_appendI append_eq_appendI calculation(3) eq_Nil_appendI 
                  list_subset_iff_projection_neutral Cons.prems(3) Cons.prems(5) 
                  projection_concatenation_commute t1_is_r1_v'_s1)
              moreover
              have "?tau  EES2 @ t2  TrES2"
                proof -
                  from v'_notin_E2 have "[𝒱']  EES2 = []"
                    by (simp add: projection_def)
                  with Cons(7) Cons(4) t1_is_r1_v'_s1 v'_notin_E2 r1_in_Nv1star 
                    Nv1_inter_E2_empty r1E2_empty
                    show ?thesis
                      by (simp only: t1_is_r1_v'_s1 list_subset_iff_projection_neutral 
                        projection_concatenation_commute, auto)
                qed
              moreover
              from Cons(8) t1_is_r1_v'_s1 r1_Vv_empty v'_in_E1 v'_in_Vv 
              have "lambda'  EES1 = s1  V𝒱"
                by (simp add: projection_def)
              moreover
              from Cons(9) v'_notin_E2 have "lambda'  EES2 = t2  V𝒱"         
                by (simp add: projection_def)
              moreover
              note s1_Cv1_empty Cons(11)
              moreover
              note Cons.hyps(1)[of ?tau s1 t2]
              ultimately obtain t'
                where τr1v't'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'_Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'_Cv_empty: "t'  C𝒱 = []"
                by auto

              let ?t = "r1 @ [𝒱'] @ t'"
              
              (* conclude that ?t is a suitable choice *)
              note τr1v't'_in_Tr
              moreover
              from r1_Vv_empty t'_Vv_is_lambda' v'_in_Vv have "?t  V𝒱 = 𝒱' # lambda'"
                by (simp add: projection_def)
              moreover
              have "?t  C𝒱 = []"
              proof -
                have "r1  C𝒱 = []"
                  using propSepViews unfolding properSeparationOfViews_def                
                  by (metis  projection_on_subset2 r1_Cv1_empty r1_in_E1star)
                with v'_in_Vv VIsViewOnE t'_Cv_empty show ?thesis
                  by (simp add: isViewOn_def V_valid_def VC_disjoint_def projection_def, auto)
              qed
              ultimately have ?thesis
                by auto
            }
            moreover {              
              assume v'_in_Vv2_minus_E1: "𝒱'  V𝒱2 - EES1"
              hence v'_in_Vv2: "𝒱'  V𝒱2"
                by auto
              with v'_in_Vv propSepViews 
              have v'_in_E2: "𝒱'  EES2"
                unfolding properSeparationOfViews_def by auto

              from v'_in_Vv2_minus_E1 
              have v'_notin_E1: "𝒱'  EES1"
                by (auto)
              with validV1 
              have v'_notin_Vv1: "𝒱'  V𝒱1"
                by (simp add: isViewOn_def V_valid_def  VC_disjoint_def 
                  VN_disjoint_def NC_disjoint_def, auto)

              (* split t2 w.r.t. 𝒱' *)
              from Cons(3) Cons(5) Cons(9) v'_in_E2 have "t2  V𝒱 = 𝒱' # (lambda'  EES2)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r2 s2 
                where t2_is_r2_v'_s2: "t2 = r2 @ [𝒱'] @ s2"
                and r2_Vv_empty: "r2  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱2" "V𝒱" "r2"]
              have r2_Vv2_empty: "r2  V𝒱2 = []"
                by auto

              (* properties of r2 s2 *)
              from t2_is_r2_v'_s2 Cons(11) have r2_Cv2_empty: "r2  C𝒱2 = []"
                by (simp add: projection_concatenation_commute)

              from t2_is_r2_v'_s2 Cons(11) have s2_Cv2_empty: "s2  C𝒱2 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(5) t2_is_r2_v'_s2 have r2_in_E2star: "set r2  EES2"
                by auto

              have r2_in_Nv2star: "set r2  N𝒱2"
              proof -
                note r2_in_E2star
                moreover
                from r2_Vv2_empty have "set r2  V𝒱2 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                    disjoint_eq_subset_Compl list_subset_iff_projection_neutral projection_on_union)
                moreover
                from r2_Cv2_empty have "set r2  C𝒱2 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                    disjoint_eq_subset_Compl list_subset_iff_projection_neutral projection_on_union)
                moreover
                note validV2
                ultimately show ?thesis
                  by (simp add: isViewOn_def V_valid_def  
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
              qed
              
              have r2E1_in_Nv2_inter_C1_star: "set (r2  EES1)  (N𝒱2  C𝒱1)"
              proof -
                have "set (r2  EES1) = set r2  EES1"
                  by (simp add: projection_def, auto)
                with r2_in_Nv2star have "set (r2  EES1)  (EES1  N𝒱2)"
                  by auto
                moreover 
                from validV1 propSepViews disjoint_Nv2_Vv1 have "EES1  N𝒱2 = N𝒱2  C𝒱1"
                  unfolding properSeparationOfViews_def
                  by (simp add: isViewOn_def V_valid_def  VC_disjoint_def 
                    VN_disjoint_def NC_disjoint_def, auto)
                ultimately show ?thesis
                  by auto
              qed

              note outerCons_prems = Cons.prems

              (* repair t1 by inserting r2 ↿ EES1 *)
              have "set (r2  EES1)  (N𝒱2  C𝒱1)  
                 t1'. ( set t1'  EES1 
                 ((τ @ r2)  EES1) @ t1'  TrES1 
                 t1'  V𝒱1 = t1  V𝒱1 
                 t1'  C𝒱1 = [] )"
              proof (induct "r2  EES1" arbitrary: r2 rule: rev_induct)
                case Nil thus ?case 
                  by (metis append_self_conv outerCons_prems(9) outerCons_prems(3) 
                    outerCons_prems(5) projection_concatenation_commute)
              next
                case (snoc x xs)

                have xs_is_xsE1: "xs = xs  EES1"
                proof -
                  from snoc(2) have "set (xs @ [x])  EES1"
                    by (simp add: projection_def, auto)
                  hence "set xs  EES1"
                    by auto
                  thus ?thesis
                    by (simp add: list_subset_iff_projection_neutral)
                qed
                moreover
                have "set (xs  EES1)  (N𝒱2  C𝒱1)"
                proof -
                  have "set (r2  EES1)  (N𝒱2  C𝒱1)"                      
                    by (metis Int_commute snoc.prems)
                  with snoc(2) have "set (xs @ [x])  (N𝒱2  C𝒱1)"
                    by simp
                  hence "set xs  (N𝒱2  C𝒱1)"
                    by auto
                  with xs_is_xsE1 show ?thesis
                    by auto
                qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain t1''
                  where t1''_in_E1star: "set t1''  EES1"
                  and τ_xs_E1_t1''_in_Tr1: "((τ @ xs)  EES1) @ t1''  TrES1"
                  and t1''Vv1_is_t1Vv1: "t1''  V𝒱1 = t1  V𝒱1"
                  and t1''Cv1_empty: "t1''  C𝒱1 = []"
                  by auto
                
                have x_in_Cv1_inter_Nv2: "x  C𝒱1  N𝒱2"
                proof -
                  from snoc(2-3) have "set (xs @ [x])  (N𝒱2  C𝒱1)"
                    by simp
                  thus ?thesis
                    by auto
                qed
                hence x_in_Cv1: "x  C𝒱1"
                  by auto
                moreover
                note τ_xs_E1_t1''_in_Tr1 t1''Cv1_empty
                moreover
                have Adm: "(Adm 𝒱1 ρ1 TrES1 ((τ @ xs)  EES1) x)"
                proof -
                  from τ_xs_E1_t1''_in_Tr1 validES1 
                  have τ_xsE1_in_Tr1: "((τ @ xs)  EES1)  TrES1"
                    by (simp add: ES_valid_def traces_prefixclosed_def 
                      prefixclosed_def prefix_def)
                  with x_in_Cv1_inter_Nv2 total_ES1_Cv1_inter_Nv2 
                  have τ_xsE1_x_in_Tr1: "((τ @ xs)  EES1) @ [x]  TrES1"
                    by (simp only: total_def)
                  moreover
                  have "((τ @ xs)  EES1)  (ρ1 𝒱1) = ((τ @ xs)  EES1)  (ρ1 𝒱1)" ..
                  ultimately show ?thesis
                    by (simp add: Adm_def, auto)
                qed
                moreover note BSIA
                ultimately obtain t1'
                  where res1: "((τ @ xs)  EES1) @ [x] @ t1'  TrES1"
                  and res2: "t1'  V𝒱1 = t1''  V𝒱1"
                  and res3: "t1'  C𝒱1 = []"
                  by (simp only: BSIA_def, blast)

                have "set t1'  EES1"
                proof -
                  from res1 validES1 have "set (((τ @ xs)  EES1) @ [x] @ t1')  EES1"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  thus ?thesis
                    by auto
                qed
                moreover 
                have "((τ @ r2)  EES1) @ t1'  TrES1"
                proof -
                  from res1 xs_is_xsE1 have "((τ  EES1) @ (xs @ [x])) @ t1'  TrES1"
                    by (simp only: projection_concatenation_commute, auto)
                  thus  ?thesis
                    by (simp only: snoc(2) projection_concatenation_commute)
                qed
                moreover
                from t1''Vv1_is_t1Vv1 res2 have "t1'  V𝒱1 = t1  V𝒱1"
                  by auto
                moreover
                note res3
                ultimately show ?case
                  by auto
              qed
              from this[OF r2E1_in_Nv2_inter_C1_star] obtain t1'
                where t1'_in_E1star: "set t1'  EES1" 
                and τr2E1_t1'_in_Tr1: "((τ @ r2)  EES1) @ t1'  TrES1"
                and t1'_Vv1_is_t1_Vv1: "t1'  V𝒱1 = t1  V𝒱1"
                and t1'_Cv1_empty: "t1'  C𝒱1 = []"
                by auto
              
              (* apply inductive hypothesis on lambda' t1' s2 *)
              let ?tau = "τ @ r2 @ [𝒱']"
              
              from v'_in_E2 Cons(2) r2_in_Nv2star validV2 have "set ?tau  E(ES1  ES2)"
                by (simp only: composeES_def isViewOn_def V_valid_def  
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              from Cons(5) t2_is_r2_v'_s2 have "set s2  EES2"
                by auto
              moreover
              note t1'_in_E1star
              moreover
              have "?tau  EES2 @ s2  TrES2"              
                by (metis Cons_eq_appendI append_eq_appendI calculation(3) eq_Nil_appendI 
                  list_subset_iff_projection_neutral Cons.prems(4) Cons.prems(6) 
                  projection_concatenation_commute t2_is_r2_v'_s2)
              moreover
              from τr2E1_t1'_in_Tr1 v'_notin_E1 have "?tau  EES1 @ t1'  TrES1"
                by (simp add: projection_def)
              moreover
              from Cons(9) t2_is_r2_v'_s2 r2_Vv_empty v'_in_E2 v'_in_Vv 
              have "lambda'  EES2 = s2  V𝒱"
                by (simp add: projection_def)
              moreover
              from Cons(10) v'_notin_E1 t1'_Vv1_is_t1_Vv1 have "lambda'  EES1 = t1'  V𝒱"         
              proof -
                have "t1'  V𝒱 = t1'  V𝒱1"
                  using propSepViews unfolding properSeparationOfViews_def
                  by (simp add: projection_def, metis Int_commute 
                     projection_def projection_intersection_neutral 
                    t1'_in_E1star)
                moreover
                have "t1  V𝒱 = t1  V𝒱1"
                  using propSepViews unfolding properSeparationOfViews_def         
                  by (simp add: projection_def, metis Int_commute 
                     projection_def 
                    projection_intersection_neutral Cons(4))
                moreover
                note Cons(8) v'_notin_E1 t1'_Vv1_is_t1_Vv1
                ultimately show ?thesis
                  by (simp add: projection_def)
              qed
              moreover
              note s2_Cv2_empty t1'_Cv1_empty
              moreover
              note Cons.hyps(1)[of ?tau t1' s2]
              ultimately obtain t'
                where τr2v't'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'_Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'_Cv_empty: "t'  C𝒱 = []"
                by auto

              let ?t = "r2 @ [𝒱'] @ t'"
              
              (* conclude that ?t is a suitable choice *)
              note τr2v't'_in_Tr
              moreover
              from r2_Vv_empty t'_Vv_is_lambda' v'_in_Vv 
              have "?t  V𝒱 = 𝒱' # lambda'"
                by (simp add: projection_def)
              moreover
              have "?t  C𝒱 = []"
              proof -
                have "r2  C𝒱 = []"
                proof -
                  from propSepViews have "C𝒱  EES2  C𝒱2"
                    unfolding properSeparationOfViews_def by auto
                  from projection_on_subset[OF ‹C𝒱  EES2  C𝒱2 r2_Cv2_empty] 
                  have "r2  (EES2  C𝒱) = []"
                    by (simp only: Int_commute)
                  with projection_intersection_neutral[OF r2_in_E2star, of "C𝒱"] show ?thesis
                    by simp
                qed
                with v'_in_Vv VIsViewOnE t'_Cv_empty show ?thesis
                  by (simp add: isViewOn_def V_valid_def  VC_disjoint_def 
                    VN_disjoint_def NC_disjoint_def projection_def, auto)
              qed
              ultimately have ?thesis
                by auto
            }
            ultimately show ?thesis
              by blast
          qed 
        qed 
    }
    thus ?thesis
      by auto
qed

 (* Generalized zipping lemma for case three of lemma 6.4.4 *)
lemma generalized_zipping_lemma3: " N𝒱2  EES1 = {}; total ES2 (C𝒱2  N𝒱1); BSIA ρ2 𝒱2 TrES2   
   τ lambda t1 t2. ( ( set τ  E(ES1  ES2)  set lambda  V𝒱  set t1  EES1  set t2  EES2
   ((τ  EES1) @ t1)  TrES1  ((τ  EES2) @ t2)  TrES2
   (lambda  EES1) = (t1  V𝒱)  (lambda  EES2) = (t2  V𝒱)
   (t1  C𝒱1) = []  (t2  C𝒱2) = []) 
   ( t. ((τ @ t)  Tr(ES1  ES2)  (t  V𝒱) = lambda  (t  C𝒱) = [])) )"
proof -
  assume Nv2_inter_E1_empty: "N𝒱2  EES1 = {}"
  assume total_ES2_Cv2_inter_Nv1: "total ES2 (C𝒱2  N𝒱1)"
  assume BSIA: "BSIA ρ2 𝒱2 TrES2"

  {
    fix τ lambda t1 t2
    assume τ_in_Estar: "set τ  E(ES1  ES2)"
      and lambda_in_Vvstar: "set lambda  V𝒱"
      and t1_in_E1star: "set t1  EES1"
      and t2_in_E2star: "set t2  EES2"
      and τ_E1_t1_in_Tr1: "((τ  EES1) @ t1)  TrES1"
      and τ_E2_t2_in_Tr2: "((τ  EES2) @ t2)  TrES2"
      and lambda_E1_is_t1_Vv: "(lambda  EES1) = (t1  V𝒱)"
      and lambda_E2_is_t2_Vv: "(lambda  EES2) = (t2  V𝒱)"
      and t1_no_Cv1: "(t1  C𝒱1) = []"
      and t2_no_Cv2: "(t2  C𝒱2) = []"

    have " set τ  E(ES1  ES2);
      set lambda  V𝒱; 
      set t1  EES1;
      set t2  EES2;
      ((τ  EES1) @ t1)  TrES1;
      ((τ  EES2) @ t2)  TrES2;
      (lambda  EES1) = (t1  V𝒱);
      (lambda  EES2) = (t2  V𝒱);
      (t1  C𝒱1) = [];
      (t2  C𝒱2) = []   
       ( t. ((τ @ t)  Tr(ES1  ES2)  (t  V𝒱) = lambda  (t  C𝒱) = []))"
      proof (induct lambda arbitrary: τ t1 t2)
        case (Nil τ t1 t2)
        
        have "(τ @ [])  Tr(ES1  ES2)"
          proof -
            have "τ  Tr(ES1  ES2)"
              proof -
                from Nil(5) validES1 have "τ  EES1  TrES1"
                  by (simp add: ES_valid_def traces_prefixclosed_def 
                    prefixclosed_def prefix_def)
                moreover
                from Nil(6) validES2 have "τ  EES2  TrES2"
                  by (simp add: ES_valid_def traces_prefixclosed_def 
                    prefixclosed_def prefix_def)
                moreover 
                note Nil(1)
                ultimately show ?thesis
                  by (simp add: composeES_def)
              qed
            thus ?thesis
              by auto
          qed
        moreover
        have "([]  V𝒱) = []"
          by (simp add: projection_def)
        moreover
        have "([]  C𝒱) = []"
          by (simp add: projection_def)
        ultimately show ?case
          by blast
      next
        case (Cons 𝒱' lambda' τ t1 t2) 
        thus ?case
          proof -
            from Cons(3) have v'_in_Vv: "𝒱'  V𝒱"
              by auto

            have "𝒱'  V𝒱1  V𝒱2 
               𝒱'  V𝒱1 - EES2
               𝒱'  V𝒱2 - EES1" 
              using propSepViews unfolding properSeparationOfViews_def             
              by (metis Diff_iff Int_commute Int_iff Un_iff  
                 Vv_is_Vv1_union_Vv2 v'_in_Vv)
            moreover {
              assume v'_in_Vv1_inter_Vv2: "𝒱'  V𝒱1  V𝒱2"
              hence v'_in_Vv2: "𝒱'  V𝒱2" and v'_in_Vv1: "𝒱'  V𝒱1" 
                by auto
              with v'_in_Vv  
              have v'_in_E2: "𝒱'  EES2" and v'_in_E1: "𝒱'  EES1"
               using propSepViews unfolding properSeparationOfViews_def  by auto

              (* split t1 w.r.t. 𝒱' *)
              from Cons(2,4,8) v'_in_E1 have "t1  V𝒱 = 𝒱' # (lambda'  EES1)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r1 s1 
                where t1_is_r1_v'_s1: "t1 = r1 @ [𝒱'] @ s1"
                and r1_Vv_empty: "r1  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱1" "V𝒱" "r1"]
              have r1_Vv1_empty: "r1  V𝒱1 = []"
                by auto

              (* properties of r1 s1 *)
              from t1_is_r1_v'_s1 Cons(10) have r1_Cv1_empty: "r1  C𝒱1 = []"
                by (simp add: projection_concatenation_commute)

              from t1_is_r1_v'_s1 Cons(10) have s1_Cv1_empty: "s1  C𝒱1 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(4) t1_is_r1_v'_s1 
              have r1_in_E1star: "set r1  EES1" and s1_in_E1star: "set s1  EES1"
                by auto

              from Cons(6) t1_is_r1_v'_s1 
              have τE1_r1_v'_s1_in_Tr1: "τ  EES1 @ r1 @ [𝒱'] @ s1  TrES1"
                by simp

              have r1_in_Nv1star: "set r1  N𝒱1"
                proof -
                  note r1_in_E1star
                  moreover
                  from r1_Vv1_empty have "set r1  V𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  from r1_Cv1_empty have "set r1  C𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  note validV1
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def  VC_disjoint_def 
                      VN_disjoint_def NC_disjoint_def, auto)
                qed
              
              have r1E2_in_Nv1_inter_C2_star: "set (r1  EES2)  (N𝒱1  C𝒱2)"
                proof -
                  have "set (r1  EES2) = set r1  EES2"
                    by (simp add: projection_def, auto)
                  with r1_in_Nv1star have "set (r1  EES2)  (EES2  N𝒱1)"
                    by auto
                  moreover 
                  from validV2  disjoint_Nv1_Vv2 
                  have "EES2  N𝒱1 = N𝒱1  C𝒱2"
                    using propSepViews unfolding properSeparationOfViews_def
                    by (simp add:isViewOn_def  V_valid_def 
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                  ultimately show ?thesis
                    by auto
                qed
 
              note outerCons_prems = Cons.prems

              (* repair t2 by inserting r1 ↿ EES2 *)
              have "set (r1  EES2)  (N𝒱1  C𝒱2)  
                 t2'. ( set t2'  EES2 
                 ((τ @ r1)  EES2) @ t2'  TrES2 
                 t2'  V𝒱2 = t2  V𝒱2 
                 t2'  C𝒱2 = [] )"
              proof (induct "r1  EES2" arbitrary: r1 rule: rev_induct)
                case Nil thus ?case     
                  by (metis append_self_conv outerCons_prems(10) outerCons_prems(4) 
                    outerCons_prems(6) projection_concatenation_commute)
              next
                case (snoc x xs)

                have xs_is_xsE2: "xs = xs  EES2"
                  proof -
                    from snoc(2) have "set (xs @ [x])  EES2"
                      by (simp add: projection_def, auto)
                    hence "set xs  EES2"
                      by auto
                    thus ?thesis
                      by (simp add: list_subset_iff_projection_neutral)
                  qed
                moreover
                have "set (xs  EES2)  (N𝒱1  C𝒱2)"
                  proof -
                    have "set (r1  EES2)  (N𝒱1  C𝒱2)"                      
                      by (metis Int_commute snoc.prems)
                    with snoc(2) have "set (xs @ [x])  (N𝒱1  C𝒱2)"
                      by simp
                    hence "set xs  (N𝒱1  C𝒱2)"
                      by auto
                    with xs_is_xsE2 show ?thesis
                      by auto
                  qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain t2''
                  where t2''_in_E2star: "set t2''  EES2"
                  and τ_xs_E2_t2''_in_Tr2: "((τ @ xs)  EES2) @ t2''  TrES2"
                  and t2''Vv2_is_t2Vv2: "t2''  V𝒱2 = t2  V𝒱2"
                  and t2''Cv2_empty: "t2''  C𝒱2 = []"
                  by auto
                              
                have x_in_Cv2_inter_Nv1: "x  C𝒱2  N𝒱1"
                  proof -
                    from snoc(2-3) have "set (xs @ [x])  (N𝒱1  C𝒱2)"
                      by simp
                    thus ?thesis
                      by auto
                  qed
                hence x_in_Cv2: "x  C𝒱2"
                  by auto
                moreover
                note τ_xs_E2_t2''_in_Tr2 t2''Cv2_empty
                moreover
                have Adm: "(Adm 𝒱2 ρ2 TrES2 ((τ @ xs)  EES2) x)"
                  proof -
                    from τ_xs_E2_t2''_in_Tr2 validES2
                    have τ_xsE2_in_Tr2: "((τ @ xs)  EES2)  TrES2"
                      by (simp add: ES_valid_def traces_prefixclosed_def
                        prefixclosed_def prefix_def)
                    with x_in_Cv2_inter_Nv1 total_ES2_Cv2_inter_Nv1 
                    have τ_xsE2_x_in_Tr2: "((τ @ xs)  EES2) @ [x]  TrES2"
                      by (simp only: total_def)
                    moreover
                    have "((τ @ xs)  EES2)  (ρ2 𝒱2) = ((τ @ xs)  EES2)  (ρ2 𝒱2)" ..
                    ultimately show ?thesis
                      by (simp add: Adm_def, auto)
                  qed
                moreover note BSIA
                ultimately obtain t2'
                  where res1: "((τ @ xs)  EES2) @ [x] @ t2'  TrES2"
                  and res2: "t2'  V𝒱2 = t2''  V𝒱2"
                  and res3: "t2'  C𝒱2 = []"
                  by (simp only: BSIA_def, blast)

                have "set t2'  EES2"
                  proof -
                    from res1 validES2
                    have "set (((τ @ xs)  EES2) @ [x] @ t2')  EES2"
                      by (simp add: ES_valid_def traces_contain_events_def, auto)
                    thus ?thesis
                      by auto
                  qed
                moreover 
                have "((τ @ r1)  EES2) @ t2'  TrES2"
                  proof -
                    from res1 xs_is_xsE2 have "((τ  EES2) @ (xs @ [x])) @ t2'  TrES2"
                      by (simp only: projection_concatenation_commute, auto)
                    thus  ?thesis
                      by (simp only: snoc(2) projection_concatenation_commute)
                  qed
                moreover
                from t2''Vv2_is_t2Vv2 res2 have "t2'  V𝒱2 = t2  V𝒱2"
                  by auto
                moreover
                note res3
                ultimately show ?case
                  by auto
              qed
              from this[OF r1E2_in_Nv1_inter_C2_star] obtain t2'
                where t2'_in_E2star: "set t2'  EES2" 
                and τr1E2_t2'_in_Tr2: "((τ @ r1)  EES2) @ t2'  TrES2"
                and t2'_Vv2_is_t2_Vv2: "t2'  V𝒱2 = t2  V𝒱2"
                and t2'_Cv2_empty: "t2'  C𝒱2 = []"
                by auto

              (* split t2' w.r.t. 𝒱' *)
              have "t2'  V𝒱2 = 𝒱' # (lambda'  EES2)"
                proof -
                  from projection_intersection_neutral[OF Cons(5), of "V𝒱"] 
                  have "t2  V𝒱 = t2  V𝒱2"
                    using propSepViews unfolding properSeparationOfViews_def
                    by (simp only: Int_commute)
                  with Cons(9) t2'_Vv2_is_t2_Vv2 v'_in_E2 show ?thesis
                    by (simp add: projection_def)
                qed
              from projection_split_first[OF this] obtain r2' s2'
                where t2'_is_r2'_v'_s2': "t2' = r2' @ [𝒱'] @ s2'"
                and r2'_Vv2_empty: "r2'  V𝒱2 = []"
                by auto
              
              (* properties of r2' s2' *)
              from t2'_is_r2'_v'_s2' t2'_Cv2_empty 
              have r2'_Cv2_empty: "r2'  C𝒱2 = []"
                by (simp add: projection_concatenation_commute)
              
              from t2'_is_r2'_v'_s2' t2'_Cv2_empty 
              have s2'_Cv2_empty: "s2'  C𝒱2 = []"
                by (simp only: projection_concatenation_commute, auto)
              
              from t2'_in_E2star t2'_is_r2'_v'_s2' 
              have r2'_in_E2star: "set r2'  EES2"
                by auto
              with  r2'_Vv2_empty 
              have r2'_Vv_empty: "r2'  V𝒱 = []"
                using propSepViews unfolding properSeparationOfViews_def
                by (metis projection_on_subset2 subset_iff_psubset_eq)

              have r2'_in_Nv2star: "set r2'  N𝒱2"
                proof - 
                  note r2'_in_E2star
                  moreover
                  from r2'_Vv2_empty have "set r2'  V𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  from r2'_Cv2_empty have "set r2'  C𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  note validV2
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def  VC_disjoint_def 
                      VN_disjoint_def NC_disjoint_def, auto)
                qed
              with Nv2_inter_E1_empty have r2'E1_empty: "r2'  EES1 = []"               
                by (metis Int_commute empty_subsetI projection_on_subset2 r2'_Vv2_empty)
              
              (* apply inductive hypothesis to lambda' s1 s2' *)
              let ?tau = "τ @ r1 @ r2' @ [𝒱']"
           
              from Cons(2) r1_in_E1star r2'_in_E2star v'_in_E1 
              have "set ?tau  (E(ES1  ES2))"
                by (simp add: composeES_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              note s1_in_E1star
              moreover
              from t2'_in_E2star t2'_is_r2'_v'_s2' have "set s2'  EES2"
                by simp
              moreover
              from r1_in_E1star v'_in_E1 r2'E1_empty τE1_r1_v'_s1_in_Tr1 
              have "?tau  EES1 @ s1  TrES1"
                by (simp only: list_subset_iff_projection_neutral 
                  projection_concatenation_commute projection_def, auto)
              moreover
              from τr1E2_t2'_in_Tr2 t2'_is_r2'_v'_s2' v'_in_E2 
              have "?tau  EES2 @ s2'  TrES2"
                proof -
                  from v'_in_E2 r2'_in_E2star 
                  have  "(τ @ r1 @ r2' @ [𝒱'])  EES2 =  (τ @ r1)  EES2 @ r2' @ [𝒱']"
                    by (simp only: projection_concatenation_commute 
                      list_subset_iff_projection_neutral projection_def, auto)
                  with τr1E2_t2'_in_Tr2 t2'_is_r2'_v'_s2' v'_in_E2 show ?thesis
                    by simp
                qed
              moreover
              have "lambda'  EES1 = s1  V𝒱"
              proof -
                from Cons(3,4,8) v'_in_E1 have "t1  V𝒱 = [𝒱'] @ (lambda'  EES1)"
                  by (simp add: projection_def)
                moreover
                from t1_is_r1_v'_s1 r1_Vv_empty v'_in_Vv1 Vv_is_Vv1_union_Vv2
                have "t1  V𝒱 = [𝒱'] @ (s1  V𝒱)"
                  by (simp only: t1_is_r1_v'_s1 projection_concatenation_commute projection_def, auto)
                ultimately show ?thesis
                  by auto
              qed
              moreover
              have "lambda'  EES2 = s2'  V𝒱"
              proof -
                from Cons(4,5,9)  v'_in_E2 have "t2  V𝒱 = [𝒱'] @ (lambda'  EES2)"
                  by (simp add: projection_def)
                moreover            
                from t2'_is_r2'_v'_s2' r2'_Vv2_empty r2'_in_E2star v'_in_Vv2 propSepViews
                have "t2'  V𝒱 = [𝒱'] @ (s2'  V𝒱)"
                proof -
                  have "r2'  V𝒱 =[]"
                    using propSepViews unfolding properSeparationOfViews_def
                    by (metis projection_on_subset2 
                      r2'_Vv2_empty r2'_in_E2star subset_iff_psubset_eq)
                  with t2'_is_r2'_v'_s2' v'_in_Vv2 Vv_is_Vv1_union_Vv2 show ?thesis                    
                    by (simp only: t2'_is_r2'_v'_s2' projection_concatenation_commute 
                      projection_def, auto)
                qed
                moreover
                have "t2  V𝒱 = t2'  V𝒱"
                  using propSepViews unfolding properSeparationOfViews_def
                  by (metis Int_commute  outerCons_prems(4) 
                    projection_intersection_neutral 
                    t2'_Vv2_is_t2_Vv2 t2'_in_E2star)
                ultimately show ?thesis
                  by auto
              qed
              moreover
              note s1_Cv1_empty s2'_Cv2_empty Cons.hyps[of ?tau s1 s2']
              ultimately obtain t'
                where tau_t'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'Cv_empty: "t'  C𝒱 = []"
                by auto
              
              let ?t = "r1 @ r2' @ [𝒱'] @ t'"

              (* conclude that ?t is a suitable choice *)
              note tau_t'_in_Tr
              moreover
              from r1_Vv_empty r2'_Vv_empty t'Vv_is_lambda' v'_in_Vv 
              have "?t  V𝒱 = 𝒱' # lambda'"
                by(simp only: projection_concatenation_commute projection_def, auto)
              moreover
              from VIsViewOnE r1_Cv1_empty t'Cv_empty r2'_Cv2_empty v'_in_Vv 
              have "?t  C𝒱 = []"
              proof -
                from VIsViewOnE v'_in_Vv have "[𝒱']  C𝒱 = []"
                  by (simp add:isViewOn_def V_valid_def VC_disjoint_def 
                    VN_disjoint_def NC_disjoint_def projection_def, auto)
                moreover
                from r1_in_E1star r1_Cv1_empty  
                have "r1  C𝒱 = []"
                  using propSepViews projection_on_subset2 unfolding properSeparationOfViews_def     
                  by auto
                moreover
                from r2'_in_E2star r2'_Cv2_empty 
                have "r2'  C𝒱 = []"
                  using propSepViews projection_on_subset2 unfolding properSeparationOfViews_def     
                  by auto
                moreover
                note t'Cv_empty
                ultimately show ?thesis
                  by (simp only: projection_concatenation_commute, auto)
              qed
              ultimately have ?thesis
                by auto
            }
            moreover {
              assume v'_in_Vv1_minus_E2: "𝒱'  V𝒱1 - EES2"
              hence v'_in_Vv1: "𝒱'  V𝒱1"
                by auto
              with v'_in_Vv  have v'_in_E1: "𝒱'  EES1"
                using propSepViews unfolding properSeparationOfViews_def
                by auto

              from v'_in_Vv1_minus_E2 have v'_notin_E2: "𝒱'  EES2"
                by (auto)
              with validV2 have v'_notin_Vv2: "𝒱'  V𝒱2"
                by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
                  VN_disjoint_def NC_disjoint_def, auto)

              (* split t1 w.r.t. 𝒱' *)
              from Cons(3) Cons(4) Cons(8) v'_in_E1 
              have "t1  V𝒱 = 𝒱' # (lambda'  EES1)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r1 s1 
                where t1_is_r1_v'_s1: "t1 = r1 @ [𝒱'] @ s1"
                and r1_Vv_empty: "r1  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱1" "V𝒱" "r1"]
              have r1_Vv1_empty: "r1  V𝒱1 = []"
                by auto

              (* properties of r1 s1 *)
              from t1_is_r1_v'_s1 Cons(10) have r1_Cv1_empty: "r1  C𝒱1 = []"
                by (simp add: projection_concatenation_commute)

              from t1_is_r1_v'_s1 Cons(10) have s1_Cv1_empty: "s1  C𝒱1 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(4) t1_is_r1_v'_s1 have r1_in_E1star: "set r1  EES1"
                by auto

              have r1_in_Nv1star: "set r1  N𝒱1"
              proof -
                note r1_in_E1star
                moreover
                from r1_Vv1_empty have "set r1  V𝒱1 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Diff_eq 
                    Int_commute Int_empty_right disjoint_eq_subset_Compl 
                    list_subset_iff_projection_neutral projection_on_union)
                moreover
                from r1_Cv1_empty have "set r1  C𝒱1 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Diff_eq Int_commute Int_empty_right 
                    disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                    projection_on_union)
                moreover
                note validV1
                ultimately show ?thesis
                  by (simp add:isViewOn_def V_valid_def VC_disjoint_def 
                    VN_disjoint_def NC_disjoint_def, auto)
              qed
              
              have r1E2_in_Nv1_inter_C2_star: "set (r1  EES2)  (N𝒱1  C𝒱2)"
              proof -
                have "set (r1  EES2) = set r1  EES2"
                  by (simp add: projection_def, auto)
                with r1_in_Nv1star have "set (r1  EES2)  (EES2  N𝒱1)"
                  by auto
                moreover 
                from validV2  disjoint_Nv1_Vv2 
                have "EES2  N𝒱1 = N𝒱1  C𝒱2"
                  using propSepViews unfolding properSeparationOfViews_def
                  by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
                    VN_disjoint_def NC_disjoint_def, auto)
                ultimately show ?thesis
                  by auto
              qed

              note outerCons_prems = Cons.prems
              
              (* repair t2 by inserting r1↿ EES2 *)
              have "set (r1  EES2)  (N𝒱1  C𝒱2)  
                 t2'. ( set t2'  EES2 
                 ((τ @ r1)  EES2) @ t2'  TrES2 
                 t2'  V𝒱2 = t2  V𝒱2 
                 t2'  C𝒱2 = [] )"
              proof (induct "r1  EES2" arbitrary: r1 rule: rev_induct)
                case Nil thus ?case 
                  by (metis append_self_conv outerCons_prems(10) outerCons_prems(4) 
                    outerCons_prems(6) projection_concatenation_commute)
              next
                case (snoc x xs)

                have xs_is_xsE2: "xs = xs  EES2"
                proof -
                  from snoc(2) have "set (xs @ [x])  EES2"
                    by (simp add: projection_def, auto)
                  hence "set xs  EES2"
                    by auto
                  thus ?thesis
                    by (simp add: list_subset_iff_projection_neutral)
                qed
                moreover
                have "set (xs  EES2)  (N𝒱1  C𝒱2)"
                proof -
                  have "set (r1  EES2)  (N𝒱1  C𝒱2)"                      
                    by (metis Int_commute snoc.prems)
                  with snoc(2) have "set (xs @ [x])  (N𝒱1  C𝒱2)"
                    by simp
                  hence "set xs  (N𝒱1  C𝒱2)"
                    by auto
                  with xs_is_xsE2 show ?thesis
                    by auto
                qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain t2''
                  where t2''_in_E2star: "set t2''  EES2"
                  and τ_xs_E2_t2''_in_Tr2: "((τ @ xs)  EES2) @ t2''  TrES2"
                  and t2''Vv2_is_t2Vv2: "t2''  V𝒱2 = t2  V𝒱2"
                  and t2''Cv2_empty: "t2''  C𝒱2 = []"
                  by auto
                
                have x_in_Cv2_inter_Nv1: "x  C𝒱2  N𝒱1"
                proof -
                  from snoc(2-3) have "set (xs @ [x])  (N𝒱1  C𝒱2)"
                    by simp
                  thus ?thesis
                    by auto
                qed
                hence x_in_Cv2: "x  C𝒱2"
                  by auto
                moreover
                note τ_xs_E2_t2''_in_Tr2 t2''Cv2_empty
                moreover
                have Adm: "(Adm 𝒱2 ρ2 TrES2 ((τ @ xs)  EES2) x)"
                proof -
                  from τ_xs_E2_t2''_in_Tr2 validES2 
                  have τ_xsE2_in_Tr2: "((τ @ xs)  EES2)  TrES2"
                    by (simp add: ES_valid_def traces_prefixclosed_def
                      prefixclosed_def prefix_def)
                  with x_in_Cv2_inter_Nv1 total_ES2_Cv2_inter_Nv1 
                  have τ_xsE2_x_in_Tr2: "((τ @ xs)  EES2) @ [x]  TrES2"
                    by (simp only: total_def)
                  moreover
                  have "((τ @ xs)  EES2)  (ρ2 𝒱2) = ((τ @ xs)  EES2)  (ρ2 𝒱2)" ..
                  ultimately show ?thesis
                    by (simp add: Adm_def, auto)
                qed
                moreover note BSIA
                ultimately obtain t2'
                  where res1: "((τ @ xs)  EES2) @ [x] @ t2'  TrES2"
                  and res2: "t2'  V𝒱2 = t2''  V𝒱2"
                  and res3: "t2'  C𝒱2 = []"
                  by (simp only: BSIA_def, blast)

                have "set t2'  EES2"
                proof -
                  from res1 validES2 have "set (((τ @ xs)  EES2) @ [x] @ t2')  EES2"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  thus ?thesis
                    by auto
                qed
                moreover 
                have "((τ @ r1)  EES2) @ t2'  TrES2"
                proof -
                  from res1 xs_is_xsE2 have "((τ  EES2) @ (xs @ [x])) @ t2'  TrES2"
                    by (simp only: projection_concatenation_commute, auto)
                  thus  ?thesis
                    by (simp only: snoc(2) projection_concatenation_commute)
                qed
                moreover
                from t2''Vv2_is_t2Vv2 res2 have "t2'  V𝒱2 = t2  V𝒱2"
                  by auto
                moreover
                note res3
                ultimately show ?case
                  by auto
              qed
              from this[OF r1E2_in_Nv1_inter_C2_star] obtain t2'
                where t2'_in_E2star: "set t2'  EES2" 
                and τr1E2_t2'_in_Tr2: "((τ @ r1)  EES2) @ t2'  TrES2"
                and t2'_Vv2_is_t2_Vv2: "t2'  V𝒱2 = t2  V𝒱2"
                and t2'_Cv2_empty: "t2'  C𝒱2 = []"
                by auto
              
              (* apply inductive hypothesis to lambda' s1 t2 *)
              let ?tau = "τ @ r1 @ [𝒱']"
              
              from v'_in_E1 Cons(2) r1_in_Nv1star validV1 have "set ?tau  E(ES1  ES2)"
                by (simp only: composeES_def isViewOn_def V_valid_def
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              from Cons(4) t1_is_r1_v'_s1 have "set s1  EES1"
                by auto
              moreover
              note t2'_in_E2star
              moreover
              have "?tau  EES1 @ s1  TrES1"              
                by (metis Cons_eq_appendI append_eq_appendI calculation(3) eq_Nil_appendI 
                  list_subset_iff_projection_neutral Cons.prems(3) Cons.prems(5) 
                  projection_concatenation_commute t1_is_r1_v'_s1)
              moreover
              from τr1E2_t2'_in_Tr2 v'_notin_E2 
              have "?tau  EES2 @ t2'  TrES2"
                by (simp add: projection_def)
              moreover
              from Cons(8) t1_is_r1_v'_s1 r1_Vv_empty v'_in_E1 v'_in_Vv 
              have "lambda'  EES1 = s1  V𝒱"
                by (simp add: projection_def)
              moreover
              from Cons(11) v'_notin_E2 t2'_Vv2_is_t2_Vv2 
              have "lambda'  EES2 = t2'  V𝒱"         
              proof -
                have "t2'  V𝒱 = t2'  V𝒱2"  
                  using propSepViews unfolding properSeparationOfViews_def
                  by (simp add: projection_def, metis Int_commute 
                     projection_def projection_intersection_neutral 
                    t2'_in_E2star)
                moreover
                have "t2  V𝒱 = t2  V𝒱2"          
                  using propSepViews unfolding properSeparationOfViews_def
                  by (simp add: projection_def, metis Int_commute 
                     projection_def 
                    projection_intersection_neutral Cons(5))
                moreover
                note Cons(9) v'_notin_E2 t2'_Vv2_is_t2_Vv2
                ultimately show ?thesis
                  by (simp add: projection_def)
              qed
              moreover
              note s1_Cv1_empty t2'_Cv2_empty
              moreover
              note Cons.hyps(1)[of ?tau s1 t2']
              ultimately obtain t'
                where tau_t'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'_Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'_Cv_empty: "t'  C𝒱 = []"
                by auto

              let ?t = "r1 @ [𝒱'] @ t'"
              
              (* conclude that ?t is a suitable choice *)
              note tau_t'_in_Tr
              moreover
              from r1_Vv_empty t'_Vv_is_lambda' v'_in_Vv 
              have "?t  V𝒱 = 𝒱' # lambda'"
                by (simp add: projection_def)
              moreover
              have "?t  C𝒱 = []"
              proof -
                have "r1  C𝒱 = []"
                proof -
                  from propSepViews have "EES1  C𝒱  C𝒱1"
                    unfolding properSeparationOfViews_def by auto
                  from projection_on_subset[OF ‹EES1  C𝒱  C𝒱1 r1_Cv1_empty] 
                  have "r1  (EES1  C𝒱) = []"
                    by (simp only: Int_commute)
                  with projection_intersection_neutral[OF r1_in_E1star, of "C𝒱"] show ?thesis
                    by simp
                qed
                with v'_in_Vv VIsViewOnE t'_Cv_empty show ?thesis
                  by (simp add:isViewOn_def V_valid_def  VC_disjoint_def 
                    VN_disjoint_def NC_disjoint_def projection_def, auto)
              qed
              ultimately have ?thesis
                by auto
            }
            moreover {              
              assume v'_in_Vv2_minus_E1: "𝒱'  V𝒱2 - EES1"
              hence v'_in_Vv2: "𝒱'  V𝒱2"
                by auto
              with v'_in_Vv  have v'_in_E2: "𝒱'  EES2"
                using propSepViews unfolding properSeparationOfViews_def            
                by auto

              from v'_in_Vv2_minus_E1 have v'_notin_E1: "𝒱'  EES1"
                by (auto)
              with validV1 have v'_notin_Vv1: "𝒱'  V𝒱1"
                by (simp add: isViewOn_def V_valid_def 
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)

               (* split t2 w.r.t. 𝒱' *)
              from Cons(4) Cons(5) Cons(9) v'_in_E2 have "t2  V𝒱 = 𝒱' # (lambda'  EES2)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r2 s2 
                where t2_is_r2_v'_s2: "t2 = r2 @ [𝒱'] @ s2"
                and r2_Vv_empty: "r2  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱2" "V𝒱" "r2"]
              have r2_Vv2_empty: "r2  V𝒱2 = []"
                by auto
              
              (* properties of r2 s2 *)
              from t2_is_r2_v'_s2 Cons(11) have r2_Cv2_empty: "r2  C𝒱2 = []"
                by (simp add: projection_concatenation_commute)

              from t2_is_r2_v'_s2 Cons(11) have s2_Cv2_empty: "s2  C𝒱2 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(5) t2_is_r2_v'_s2 have r2_in_E2star: "set r2  EES2"
                by auto

              have r2_in_Nv2star: "set r2  N𝒱2"
              proof -
                note r2_in_E2star
                moreover
                from r2_Vv2_empty have "set r2  V𝒱2 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                    disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                    projection_on_union)
                moreover
                from r2_Cv2_empty have "set r2  C𝒱2 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                    disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                    projection_on_union)
                moreover
                note validV2
                ultimately show ?thesis
                  by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
                    VN_disjoint_def NC_disjoint_def, auto)
              qed
              with Nv2_inter_E1_empty have r2E1_empty: "r2  EES1 = []"               
                by (metis Int_commute empty_subsetI projection_on_subset2 r2_Vv2_empty)
             
              (* apply inductive hypothesis to lambda' t1 r2 *)
              let ?tau = "τ @ r2 @ [𝒱']"
              
              from v'_in_E2 Cons(2) r2_in_Nv2star validV2 have "set ?tau  E(ES1  ES2)"
                by (simp only: composeES_def isViewOn_def V_valid_def
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              note Cons(4)
              moreover
              from Cons(5) t2_is_r2_v'_s2 have "set s2  EES2"
                by auto
              moreover
              have "?tau  EES1 @ t1  TrES1"
                proof -
                  from v'_notin_E1 have "[𝒱']  EES1 = []"
                    by (simp add: projection_def)
                  with Cons(6) Cons(3) t2_is_r2_v'_s2 v'_notin_E1 
                    r2_in_Nv2star Nv2_inter_E1_empty r2E1_empty
                    show ?thesis
                      by (simp only: t2_is_r2_v'_s2 list_subset_iff_projection_neutral 
                        projection_concatenation_commute, auto)
                qed
              moreover
              have "?tau  EES2 @ s2  TrES2"              
                by (metis Cons_eq_appendI append_eq_appendI calculation(4) eq_Nil_appendI 
                  list_subset_iff_projection_neutral Cons.prems(4) Cons.prems(6) 
                  projection_concatenation_commute t2_is_r2_v'_s2)
              moreover
              from Cons(8) v'_notin_E1 have "lambda'  EES1 = t1  V𝒱"         
                by (simp add: projection_def)
              moreover
              from Cons(9) t2_is_r2_v'_s2 r2_Vv_empty v'_in_E2 v'_in_Vv 
              have "lambda'  EES2 = s2  V𝒱"
                by (simp add: projection_def)
              moreover
              note Cons(10) s2_Cv2_empty
              moreover
              note Cons.hyps(1)[of ?tau t1 s2]
              ultimately obtain t'
                where tau_t'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'_Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'_Cv_empty: "t'  C𝒱 = []"
                by auto

              let ?t = "r2 @ [𝒱'] @ t'"

              (* conclude that ?t is a suitable choice *)      
              note tau_t'_in_Tr
              moreover
              from r2_Vv_empty t'_Vv_is_lambda' v'_in_Vv 
                have "?t  V𝒱 = 𝒱' # lambda'"
                by (simp add: projection_def)
              moreover
              have "?t  C𝒱 = []"
              proof -
                have "r2  C𝒱 = []"  
                  using propSepViews unfolding properSeparationOfViews_def
                  by (metis  projection_on_subset2 
                    r2_Cv2_empty r2_in_E2star)
                with v'_in_Vv VIsViewOnE t'_Cv_empty show ?thesis
                  by (simp add: isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def projection_def, auto)
              qed
              ultimately have ?thesis
                by auto
            }
            ultimately show ?thesis
              by blast
          qed 
        qed 
  }
  thus ?thesis
    by auto
qed

(* Generalized zipping lemma for case four of lemma 6.4.4 *)
lemma generalized_zipping_lemma4: 
"Γ1  EES1; ΔΓ1  EES1; ΥΓ1  EES1;Γ2  EES2; ΔΓ2  EES2; ΥΓ2  EES2;
  BSIA ρ1 𝒱1 TrES1; BSIA ρ2 𝒱2 TrES2; total ES1 (C𝒱1  N𝒱2); total ES2 (C𝒱2  N𝒱1);
  FCIA ρ1 Γ1 𝒱1 TrES1; FCIA ρ2 Γ2 𝒱2 TrES2; V𝒱1  V𝒱2 Γ1 Γ2;
  C𝒱1  N𝒱2  ΥΓ1; C𝒱2  N𝒱1  ΥΓ2;
  N𝒱1  ΔΓ1  EES2 = {}; N𝒱2  ΔΓ2  EES1 = {}  
   τ lambda t1 t2. ( ( set τ  (E(ES1  ES2))  set lambda  V𝒱   set t1  EES1
   set t2  EES2  ((τ  EES1) @ t1)  TrES1  ((τ  EES2) @ t2)  TrES2
   (lambda  EES1) = (t1  V𝒱)  (lambda  EES2) = (t2  V𝒱)
   (t1  C𝒱1) = []  (t2  C𝒱2) = []) 
   (t. ((τ @ t)  (Tr(ES1  ES2))  (t  V𝒱) = lambda  (t  C𝒱) = [])) )"
proof -
  assume Nabla1_subsetof_E1: "∇Γ1  EES1" 
  and Delta1_subsetof_E1: Γ1  EES1" 
  and Upsilon1_subsetof_E1: Γ1  EES1"
  and Nabla2_subsetof_E2: "∇Γ2  EES2" 
  and Delta2_subsetof_E2: Γ2  EES2" 
  and Upsilon2_subsetof_E2: Γ2  EES2"
  and BSIA1: "BSIA ρ1 𝒱1 TrES1" 
  and BSIA2: "BSIA ρ2 𝒱2 TrES2"
  and ES1_total_Cv1_inter_Nv2: "total ES1 (C𝒱1  N𝒱2)" 
  and ES2_total_Cv2_inter_Nv1: "total ES2 (C𝒱2  N𝒱1)"
  and FCIA1: "FCIA ρ1 Γ1 𝒱1 TrES1" 
  and FCIA2: "FCIA ρ2 Γ2 𝒱2 TrES2"
  and Vv1_inter_Vv2_subsetof_Nabla1_union_Nabla2: "V𝒱1  V𝒱2 Γ1 Γ2"
  and Cv1_inter_Nv2_subsetof_Upsilon1: "C𝒱1  N𝒱2  ΥΓ1" 
  and Cv2_inter_Nv1_subsetof_Upsilon2: "C𝒱2  N𝒱1  ΥΓ2"
  and disjoint_Nv1_inter_Delta1_inter_E2: "N𝒱1  ΔΓ1  EES2 = {}" 
  and disjoint_Nv2_inter_Delta2_inter_E1: "N𝒱2  ΔΓ2  EES1 = {}"
  
  {
    fix τ lambda t1 t2

    have " set τ  (E(ES1  ES2));
      set lambda  V𝒱; 
      set t1  EES1;
      set t2  EES2;
      ((τ  EES1) @ t1)  TrES1;
      ((τ  EES2) @ t2)  TrES2;
      (lambda  EES1) = (t1  V𝒱);
      (lambda  EES2) = (t2  V𝒱);
      (t1  C𝒱1) = [];
      (t2  C𝒱2) = []   
       ( t. ((τ @ t)  Tr(ES1  ES2)  (t  V𝒱) = lambda  (t  C𝒱) = []))"
      proof (induct lambda arbitrary: τ t1 t2)
        case (Nil τ t1 t2)
        
        have "(τ @ [])  Tr(ES1  ES2)"
          proof -
            have "τ  Tr(ES1  ES2)"
              proof -
                from Nil(5) validES1 have "τ  EES1  TrES1"
                  by (simp add: ES_valid_def traces_prefixclosed_def
                    prefixclosed_def prefix_def)
                moreover
                from Nil(6) validES2 have "τ  EES2  TrES2"
                  by (simp add: ES_valid_def traces_prefixclosed_def
                    prefixclosed_def prefix_def)
                moreover 
                note Nil(1)
                ultimately show ?thesis
                  by (simp add: composeES_def)
              qed
            thus ?thesis
              by auto
          qed
        moreover
        have "([]  V𝒱) = []"
          by (simp add: projection_def)
        moreover
        have "([]  C𝒱) = []"
          by (simp add: projection_def)
        ultimately show ?case
          by blast
      next
        case (Cons 𝒱' lambda' τ t1 t2) 
        thus ?case
          proof -

            from Cons(3) have v'_in_Vv: "𝒱'  V𝒱"
              by auto

            have "𝒱'  V𝒱1  V𝒱2 Γ1 
               𝒱'  V𝒱1  V𝒱2 Γ2
               𝒱'  V𝒱1 - EES2
               𝒱'  V𝒱2 - EES1"
              proof -
                let ?S = "V𝒱1  V𝒱2  ( V𝒱1 - V𝒱2 )  ( V𝒱2 - V𝒱1  )"
                have "V𝒱1  V𝒱2 = ?S"
                  by auto
                moreover
                have "V𝒱1 - V𝒱2 = V𝒱1 - EES2" 
                  and "V𝒱2 - V𝒱1 = V𝒱2 - EES1"
                  using propSepViews unfolding properSeparationOfViews_def by auto
                moreover 
                note Vv1_inter_Vv2_subsetof_Nabla1_union_Nabla2 
                  Vv_is_Vv1_union_Vv2 v'_in_Vv
                ultimately show ?thesis
                  by auto
              qed
            moreover
            { 
              assume v'_in_Vv1_inter_Vv2_inter_Nabla1: "𝒱'  V𝒱1  V𝒱2 Γ1"
              hence v'_in_Vv1: "𝒱'  V𝒱1" and v'_in_Vv2: "𝒱'  V𝒱2" 
                and v'_in_Nabla2: "𝒱' Γ1"
                by auto
              with v'_in_Vv 
              have v'_in_E1: "𝒱'  EES1" and v'_in_E2: "𝒱'  EES2"
                using propSepViews unfolding properSeparationOfViews_def by auto

              from Cons(3-4) Cons(8) v'_in_E1 have "t1  V𝒱 = 𝒱' # (lambda'  EES1)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r1 s1 
                where t1_is_r1_v'_s1: "t1 = r1 @ [𝒱'] @ s1"
                and r1_Vv_empty: "r1  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱1" "V𝒱" "r1"]
              have r1_Vv1_empty: "r1  V𝒱1 = []"
                by auto

              from t1_is_r1_v'_s1 Cons(10) have r1_Cv1_empty: "r1  C𝒱1 = []"
                by (simp add: projection_concatenation_commute)

              from t1_is_r1_v'_s1 Cons(10) have s1_Cv1_empty: "s1  C𝒱1 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(4) t1_is_r1_v'_s1 
              have r1_in_E1star: "set r1  EES1" and s1_in_E1star: "set s1  EES1"
                by auto

              have r1_in_Nv1star: "set r1  N𝒱1"
                proof -
                  note r1_in_E1star
                  moreover
                  from r1_Vv1_empty have "set r1  V𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  from r1_Cv1_empty have "set r1  C𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  note validV1
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def 
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                qed
              
              have r1E2_in_Nv1_inter_C2_star: "set (r1  EES2)  (N𝒱1  C𝒱2)"
                proof -
                  have "set (r1  EES2) = set r1  EES2"
                    by (simp add: projection_def, auto)
                  with r1_in_Nv1star have "set (r1  EES2)  (EES2  N𝒱1)"
                    by auto
                  moreover 
                  from validV2  disjoint_Nv1_Vv2 
                  have "EES2  N𝒱1 = N𝒱1  C𝒱2"
                    using propSepViews unfolding properSeparationOfViews_def
                    by (simp add: isViewOn_def V_valid_def
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                  ultimately show ?thesis
                    by auto
                qed
              with Cv2_inter_Nv1_subsetof_Upsilon2 
              have r1E2_in_Nv1_inter_C2_Upsilon2_star: "set (r1  EES2)  (N𝒱1  C𝒱2  ΥΓ2)"
                by auto
 
              note outerCons_prems = Cons.prems

              have "set (r1  EES2)  (N𝒱1  C𝒱2)  
                 t2'. ( set t2'  EES2 
                 ((τ @ r1)  EES2) @ t2'  TrES2 
                 t2'  V𝒱2 = t2  V𝒱2 
                 t2'  C𝒱2 = [] )"
              proof (induct "r1  EES2" arbitrary: r1 rule: rev_induct)
                case Nil thus ?case          
                  by (metis append_self_conv outerCons_prems(10) 
                    outerCons_prems(4) outerCons_prems(6) projection_concatenation_commute)
              next
                case (snoc x xs)

                have xs_is_xsE2: "xs = xs  EES2"
                  proof -
                    from snoc(2) have "set (xs @ [x])  EES2"
                      by (simp add: projection_def, auto)
                    hence "set xs  EES2"
                      by auto
                    thus ?thesis
                      by (simp add: list_subset_iff_projection_neutral)
                  qed
                moreover
                have "set (xs  EES2)  (N𝒱1  C𝒱2)"
                  proof -
                    have "set (r1  EES2)  (N𝒱1  C𝒱2)"                      
                      by (metis Int_commute snoc.prems)
                    with snoc(2) have "set (xs @ [x])  (N𝒱1  C𝒱2)"
                      by simp
                    hence "set xs  (N𝒱1  C𝒱2)"
                      by auto
                    with xs_is_xsE2 show ?thesis
                      by auto
                  qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain t2''
                  where t2''_in_E2star: "set t2''  EES2"
                  and τ_xs_E2_t2''_in_Tr2: "((τ @ xs)  EES2) @ t2''  TrES2"
                  and t2''Vv2_is_t2Vv2: "t2''  V𝒱2 = t2  V𝒱2"
                  and t2''Cv2_empty: "t2''  C𝒱2 = []"
                  by auto
                              
                have x_in_Cv2_inter_Nv1: "x  C𝒱2  N𝒱1"
                  proof -
                    from snoc(2-3) have "set (xs @ [x])  (N𝒱1  C𝒱2)"
                      by simp
                    thus ?thesis
                      by auto
                  qed
                hence x_in_Cv2: "x  C𝒱2"
                  by auto
                moreover
                note τ_xs_E2_t2''_in_Tr2 t2''Cv2_empty
                moreover
                have Adm: "(Adm 𝒱2 ρ2 TrES2 ((τ @ xs)  EES2) x)"
                  proof -
                    from τ_xs_E2_t2''_in_Tr2 validES2 
                    have τ_xsE2_in_Tr2: "((τ @ xs)  EES2)  TrES2"
                      by (simp add: ES_valid_def traces_prefixclosed_def
                        prefixclosed_def prefix_def)
                    with x_in_Cv2_inter_Nv1 ES2_total_Cv2_inter_Nv1 
                    have τ_xsE2_x_in_Tr2: "((τ @ xs)  EES2) @ [x]  TrES2"
                      by (simp only: total_def)
                    moreover
                    have "((τ @ xs)  EES2)  (ρ2 𝒱2) = ((τ @ xs)  EES2)  (ρ2 𝒱2)" ..
                    ultimately show ?thesis
                      by (simp add: Adm_def, auto)
                  qed
                moreover note BSIA2
                ultimately obtain t2'
                  where res1: "((τ @ xs)  EES2) @ [x] @ t2'  TrES2"
                  and res2: "t2'  V𝒱2 = t2''  V𝒱2"
                  and res3: "t2'  C𝒱2 = []"
                  by (simp only: BSIA_def, blast)

                have "set t2'  EES2"
                  proof -
                    from res1 validES2 have "set (((τ @ xs)  EES2) @ [x] @ t2')  EES2"
                      by (simp add: ES_valid_def traces_contain_events_def, auto)
                    thus ?thesis
                      by auto
                  qed
                moreover 
                have "((τ @ r1)  EES2) @ t2'  TrES2"
                  proof -
                    from res1 xs_is_xsE2 have "((τ  EES2) @ (xs @ [x])) @ t2'  TrES2"
                      by (simp only: projection_concatenation_commute, auto)
                    thus  ?thesis
                      by (simp only: snoc(2) projection_concatenation_commute)
                  qed
                moreover
                from t2''Vv2_is_t2Vv2 res2 have "t2'  V𝒱2 = t2  V𝒱2"
                  by auto
                moreover
                note res3
                ultimately show ?case
                  by auto
              qed
              from this[OF r1E2_in_Nv1_inter_C2_star] obtain t2'
                where t2'_in_E2star: "set t2'  EES2" 
                and τr1E2_t2'_in_Tr2: "((τ @ r1)  EES2) @ t2'  TrES2"
                and t2'_Vv2_is_t2_Vv2: "t2'  V𝒱2 = t2  V𝒱2"
                and t2'_Cv2_empty: "t2'  C𝒱2 = []"
                by auto

              have "t2'  V𝒱2 = 𝒱' # (lambda'  EES2)"
                proof -
                  from projection_intersection_neutral[OF Cons(5), of "V𝒱"]  
                  have "t2  V𝒱 = t2  V𝒱2"
                    using propSepViews unfolding properSeparationOfViews_def
                    by (simp only: Int_commute)
                  with Cons(9) t2'_Vv2_is_t2_Vv2 v'_in_E2 show ?thesis
                    by (simp add: projection_def)
                qed
              from projection_split_first[OF this] obtain r2' s2'
                where t2'_is_r2'_v'_s2': "t2' = r2' @ [𝒱'] @ s2'"
                and r2'_Vv2_empty: "r2'  V𝒱2 = []"
                by auto
              
              from t2'_is_r2'_v'_s2' t2'_Cv2_empty have r2'_Cv2_empty: "r2'  C𝒱2 = []"
                by (simp add: projection_concatenation_commute)
              
              from t2'_is_r2'_v'_s2' t2'_Cv2_empty have s2'_Cv2_empty: "s2'  C𝒱2 = []"
                by (simp only: projection_concatenation_commute, auto)
              
              from t2'_in_E2star t2'_is_r2'_v'_s2' have r2'_in_E2star: "set r2'  EES2"
                by auto
              
              have r2'_in_Nv2star: "set r2'  N𝒱2"
                proof -
                  note r2'_in_E2star
                  moreover
                  from r2'_Vv2_empty have "set r2'  V𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  from r2'_Cv2_empty have "set r2'  C𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral
                      projection_on_union)
                  moreover
                  note validV2
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                qed
            
              have r2'E1_in_Nv2_inter_C1_star: "set (r2'  EES1)  (N𝒱2  C𝒱1)"
                proof -
                  have "set (r2'  EES1) = set r2'  EES1"
                    by (simp add: projection_def, auto)
                  with r2'_in_Nv2star have "set (r2'  EES1)  (EES1  N𝒱2)"
                    by auto
                  moreover 
                  from validV1  disjoint_Nv2_Vv1 
                  have "EES1  N𝒱2 = N𝒱2  C𝒱1"
                    using propSepViews unfolding properSeparationOfViews_def
                    by (simp add: isViewOn_def V_valid_def 
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                  ultimately show ?thesis
                    by auto
                qed
              with Cv1_inter_Nv2_subsetof_Upsilon1 
              have r2'E1_in_Nv2_inter_Cv1_Upsilon1_star: 
                "set (r2'  EES1)  (N𝒱2  C𝒱1  ΥΓ1)"
                by auto
            

              have "set (r2'  EES1)  (N𝒱2  C𝒱1  ΥΓ1) 
                 s1' q1'. (
                set s1'  EES1  set q1'  C𝒱1  ΥΓ1  N𝒱1  ΔΓ1 
                 (τ  EES1) @ r1 @ q1' @ [𝒱'] @ s1'  TrES1
                 q1'  (C𝒱1  ΥΓ1) = r2'  EES1
                 s1'  V𝒱1 = s1  V𝒱1
                 s1'  C𝒱1 = [])"              
              proof (induct "r2'  EES1" arbitrary: r2' rule: rev_induct)
                case Nil

                note s1_in_E1star
                moreover
                have "set []  C𝒱1  ΥΓ1  N𝒱1  ΔΓ1"
                  by auto
                moreover
                from outerCons_prems(5) t1_is_r1_v'_s1 
                have "τ  EES1 @ r1 @ [] @ [𝒱'] @ s1  TrES1"
                  by auto
                moreover
                from Nil have "[]  (C𝒱1  ΥΓ1) = r2'  EES1"
                  by (simp add: projection_def)
                moreover
                have "s1  V𝒱1 = s1  V𝒱1"..
                moreover
                note s1_Cv1_empty
                ultimately show ?case
                  by blast
                
              next
                case (snoc x xs)

                have xs_is_xsE1: "xs = xs  EES1"
                  proof -
                    from snoc(2) have "set (xs @ [x])  EES1"
                      by (simp add: projection_def, auto)
                    thus ?thesis
                      by (simp add: list_subset_iff_projection_neutral)
                  qed
                moreover
                have "set (xs  EES1)  N𝒱2  C𝒱1  ΥΓ1"
                  proof -
                    from snoc(2-3) have "set (xs @ [x])  N𝒱2  C𝒱1  ΥΓ1"
                      by simp
                    with xs_is_xsE1 show ?thesis
                      by auto
                  qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain s1'' q1'' 
                  where s1''_in_E1star: "set s1''  EES1"
                  and q1''_in_C1_inter_Upsilon1_inter_Delta1: "set q1''  C𝒱1  ΥΓ1  N𝒱1  ΔΓ1"
                  and τE1_r1_q1''_v'_s1''_in_Tr1: "(τ  EES1 @ r1 @ q1'') @ [𝒱'] @ s1''  TrES1"
                  and q1''C1_Upsilon1_is_xsE1: "q1''  (C𝒱1  ΥΓ1) = xs  EES1"
                  and s1''V1_is_s1V1: "s1''  V𝒱1 = s1  V𝒱1" 
                  and s1''C1_empty: "s1''  C𝒱1 = []"
                  by auto
                
                have x_in_Cv1_inter_Upsilon1: "x  C𝒱1  ΥΓ1" 
                  and x_in_Cv1_inter_Nv2: "x  C𝒱1  N𝒱2"
                  proof -
                    from snoc(2-3) have "set (xs @ [x])  (N𝒱2  C𝒱1  ΥΓ1)"
                      by simp
                    thus "x  C𝒱1  ΥΓ1" 
                      and  "x  C𝒱1  N𝒱2"
                      by auto
                  qed
                with validV1 have x_in_E1: "x  EES1"
                  by (simp add: isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)

                note x_in_Cv1_inter_Upsilon1
                moreover
                from v'_in_Vv1_inter_Vv2_inter_Nabla1 have "𝒱'  V𝒱1 Γ1"
                  by auto
                moreover
                note τE1_r1_q1''_v'_s1''_in_Tr1 s1''C1_empty
                moreover
                have Adm: "(Adm 𝒱1 ρ1 TrES1 (τ  EES1 @ r1 @ q1'') x)"
                  proof -
                    from τE1_r1_q1''_v'_s1''_in_Tr1 validES1 
                    have "(τ  EES1 @ r1 @ q1'')  TrES1"
                      by (simp add: ES_valid_def traces_prefixclosed_def
                        prefixclosed_def prefix_def)                   
                    with x_in_Cv1_inter_Nv2 ES1_total_Cv1_inter_Nv2 
                    have "(τ  EES1 @ r1 @ q1'') @ [x]  TrES1"
                      by (simp only: total_def)
                    moreover
                    have "(τ  EES1 @ r1 @ q1'')  (ρ1 𝒱1) = (τ  EES1 @ r1 @ q1'')  (ρ1 𝒱1)" ..
                    ultimately show ?thesis
                      by (simp only: Adm_def, blast)
                  qed
                moreover 
                note FCIA1  
                ultimately
                obtain s1' γ'
                  where res1: "(set γ')  (N𝒱1  ΔΓ1)"
                  and res2: "((τ  EES1 @ r1 @ q1'') @ [x] @ γ' @ [𝒱'] @ s1')  TrES1"
                  and res3: "(s1'  V𝒱1) = (s1''  V𝒱1)"
                  and res4: "s1'  C𝒱1 = []"
                  unfolding FCIA_def
                  by blast
                 
                let ?q1' = "q1'' @ [x] @ γ'"

                from res2 validES1 have "set s1'  EES1"
                  by (simp add: ES_valid_def traces_contain_events_def, auto)
                moreover
                from res1 x_in_Cv1_inter_Upsilon1 q1''_in_C1_inter_Upsilon1_inter_Delta1 
                have "set ?q1'  C𝒱1  ΥΓ1  N𝒱1  ΔΓ1"
                  by auto
                moreover
                from res2 have "τ  EES1 @ r1 @ ?q1' @ [𝒱'] @ s1'  TrES1"
                  by auto
                moreover
                have "?q1'  (C𝒱1  ΥΓ1) = r2'  EES1"
                  proof -
                    from validV1 res1 have "γ'  (C𝒱1  ΥΓ1) = []"
                      proof -
                        from res1 have "γ' = γ'  (N𝒱1  ΔΓ1)"
                          by (simp only: list_subset_iff_projection_neutral)
                        hence "γ'  (C𝒱1  ΥΓ1) = γ'  (N𝒱1  ΔΓ1)  (C𝒱1  ΥΓ1)"
                          by simp
                        hence "γ'  (C𝒱1  ΥΓ1) = γ'  (N𝒱1  ΔΓ1  C𝒱1  ΥΓ1)"
                          by (simp only: projection_def, auto)
                        moreover
                        from validV1 have "N𝒱1  ΔΓ1  C𝒱1  ΥΓ1 = {}"
                          by (simp add: isViewOn_def V_valid_def 
                            VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                        ultimately show ?thesis
                          by (simp add: projection_def)
                      qed
                    hence "?q1'  (C𝒱1  ΥΓ1) = (q1'' @ [x])  (C𝒱1  ΥΓ1)"
                      by (simp only: projection_concatenation_commute, auto)
                    with q1''C1_Upsilon1_is_xsE1 x_in_Cv1_inter_Upsilon1 
                    have "?q1'  (C𝒱1  ΥΓ1) = (xs  EES1) @ [x]"
                      by (simp only: projection_concatenation_commute projection_def, auto)
                    with xs_is_xsE1 snoc(2) show ?thesis
                      by simp
                  qed
                moreover
                from res3 s1''V1_is_s1V1 have "s1'  V𝒱1 = s1  V𝒱1"
                  by simp
                moreover
                note res4
                ultimately show ?case 
                  by blast
              qed
            from this[OF r2'E1_in_Nv2_inter_Cv1_Upsilon1_star] obtain s1' q1' 
              where s1'_in_E1star: "set s1'  EES1"
              and q1'_in_Cv1_inter_Upsilon1_union_Nv1_inter_Delta1: 
              "set q1'  C𝒱1  ΥΓ1  N𝒱1  ΔΓ1" 
              and τE1_r1_q1'_v'_s1'_in_Tr1: "(τ  EES1) @ r1 @ q1' @ [𝒱'] @ s1'  TrES1"
              and q1'Cv1_inter_Upsilon1_is_r2'E1: "q1'  (C𝒱1  ΥΓ1) = r2'  EES1"
              and s1'Vv1_is_s1_Vv1: "s1'  V𝒱1 = s1  V𝒱1"
              and s1'Cv1_empty: "s1'  C𝒱1 = []"
              by auto

            from q1'_in_Cv1_inter_Upsilon1_union_Nv1_inter_Delta1 validV1 
            have q1'_in_E1star: "set q1'  EES1"
              by (simp add: isViewOn_def V_valid_def  VC_disjoint_def 
                VN_disjoint_def NC_disjoint_def, auto)
          
            have r2'Cv_empty: "r2'  C𝒱 = []"
              using propSepViews unfolding properSeparationOfViews_def
              by (metis  projection_on_subset2 
                r2'_Cv2_empty r2'_in_E2star)  

            (* application of merge_property' *)
            from validES1 τE1_r1_q1'_v'_s1'_in_Tr1 
            have q1'_in_E1star: "set q1'  EES1"
              by (simp add: ES_valid_def traces_contain_events_def, auto)
            moreover
            note r2'_in_E2star
            moreover
            have q1'E2_is_r2'E1: "q1'  EES2 = r2'  EES1"
              proof -
                from q1'_in_Cv1_inter_Upsilon1_union_Nv1_inter_Delta1 
                have "q1'  (C𝒱1  ΥΓ1  N𝒱1  ΔΓ1) = q1'"
                  by (simp add: list_subset_iff_projection_neutral)
                hence "(q1'  (C𝒱1  ΥΓ1  N𝒱1  ΔΓ1))  EES2 = q1'  EES2"
                  by simp
                hence "q1'  ((C𝒱1  ΥΓ1  N𝒱1  ΔΓ1)  EES2) = q1'  EES2"
                  by (simp add: projection_def)
                hence "q1'  (C𝒱1  ΥΓ1  EES2) = q1'  EES2"
                  by (simp only: Int_Un_distrib2 disjoint_Nv1_inter_Delta1_inter_E2, auto)
                moreover
                from q1'Cv1_inter_Upsilon1_is_r2'E1 
                have "(q1'  (C𝒱1  ΥΓ1))  EES2 = (r2'  EES1)  EES2"
                  by simp
                hence "q1'  (C𝒱1  ΥΓ1  EES2) = (r2'  EES2)  EES1"
                  by (simp add: projection_def conj_commute)
                with r2'_in_E2star have "q1'  (C𝒱1  ΥΓ1  EES2) = r2'  EES1"
                  by (simp only: list_subset_iff_projection_neutral)
                ultimately show ?thesis
                  by auto
              qed  
            moreover
            have "q1'  V𝒱 = []" 
              proof -
                from q1'_in_Cv1_inter_Upsilon1_union_Nv1_inter_Delta1 
                have "q1' = q1'  (C𝒱1  ΥΓ1  N𝒱1  ΔΓ1)"
                  by (simp add: list_subset_iff_projection_neutral)
                moreover
                from q1'_in_E1star have "q1' = q1'  EES1"
                  by (simp add: list_subset_iff_projection_neutral)
                ultimately have "q1' = q1'  (C𝒱1  ΥΓ1  N𝒱1  ΔΓ1)  EES1"
                  by simp
                hence "q1'  V𝒱 = q1'  (C𝒱1  ΥΓ1  N𝒱1  ΔΓ1)  EES1  V𝒱"
                  by simp
                hence "q1'  V𝒱 = q1'  (C𝒱1  ΥΓ1  N𝒱1  ΔΓ1)  (V𝒱  EES1)"
                  by (simp add: Int_commute projection_def)
                hence "q1'  V𝒱 = q1'  ((C𝒱1  ΥΓ1  N𝒱1  ΔΓ1)  V𝒱1)"
                  using propSepViews unfolding properSeparationOfViews_def
                  by (simp add: projection_def)
                hence "q1'  V𝒱 = q1'  (V𝒱1  C𝒱1  ΥΓ1  V𝒱1  N𝒱1  ΔΓ1)"              
                  by (simp add: Int_Un_distrib2, metis Int_assoc Int_commute Int_left_commute Un_commute)
                with validV1 show ?thesis
                  by (simp add: isViewOn_def V_valid_def  VC_disjoint_def 
                    VN_disjoint_def NC_disjoint_def, auto, simp add: projection_def)
              qed
            moreover
            have "r2'  V𝒱 = []" 
              using propSepViews unfolding properSeparationOfViews_def
              by (metis Int_commute  projection_intersection_neutral 
                r2'_Vv2_empty r2'_in_E2star)
            moreover
            have q1'Cv_empty: "q1'  C𝒱 = []"
              proof -
                from q1'_in_E1star have foo: "q1' = q1'  EES1"
                  by (simp add: list_subset_iff_projection_neutral)
                hence "q1'  C𝒱 = q1'  (C𝒱  EES1)"
                  by (metis Int_commute list_subset_iff_projection_neutral projection_intersection_neutral)
                moreover
                from propSepViews have "C𝒱  EES1C𝒱1"
                  unfolding properSeparationOfViews_def by auto
                from projection_subset_elim[OF ‹C𝒱  EES1C𝒱1, of q1'] 
                have "q1'  C𝒱1  C𝒱  EES1 = q1'  (C𝒱  EES1)"
                  using propSepViews unfolding properSeparationOfViews_def
                  by (simp add: projection_def)
                hence "q1'  EES1  C𝒱1  C𝒱 = q1'  (C𝒱  EES1)"
                  by (simp add: projection_commute)
                with foo have "q1'  (C𝒱1  C𝒱) = q1'  (C𝒱  EES1)"
                  by (simp add: projection_def)
                moreover
                from q1'_in_Cv1_inter_Upsilon1_union_Nv1_inter_Delta1 
                have "q1'  (C𝒱1  C𝒱) = q1'  (C𝒱1  ΥΓ1  N𝒱1  ΔΓ1)  (C𝒱1  C𝒱)"
                  by (simp add: list_subset_iff_projection_neutral)
                moreover
                have "(C𝒱1  ΥΓ1  N𝒱1  ΔΓ1)  (C𝒱1  C𝒱) 
                    = (C𝒱1  ΥΓ1  C𝒱1  N𝒱1  ΔΓ1)  C𝒱"
                  by fast
                hence "q1'  (C𝒱1  ΥΓ1  N𝒱1  ΔΓ1)  (C𝒱1  C𝒱) 
                     = q1'  (C𝒱1  ΥΓ1  C𝒱1  N𝒱1  ΔΓ1)  C𝒱"
                  by (simp add: projection_sequence)
                moreover
                from validV1 
                have "q1'  (C𝒱1  ΥΓ1  C𝒱1  N𝒱1  ΔΓ1)  C𝒱
                  = q1'  (C𝒱1  ΥΓ1)  C𝒱"
                  by (simp add: isViewOn_def V_valid_def  
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def Int_commute)
                moreover
                from q1'Cv1_inter_Upsilon1_is_r2'E1 
                have "q1'  (C𝒱1  ΥΓ1)  C𝒱 = r2'  EES1  C𝒱"
                  by simp
                with projection_on_intersection[OF r2'Cv_empty] 
                have "q1'  (C𝒱1  ΥΓ1)  C𝒱 = []"
                  by (simp add: Int_commute projection_def)
                ultimately show ?thesis
                  by auto           
              qed
            moreover
            note r2'Cv_empty merge_property'[of q1' r2']
            ultimately obtain q'
              where q'E1_is_q1': "q'  EES1 = q1'"
              and q'E2_is_r2': "q'  EES2 = r2'"
              and q'V_empty: "q'  V𝒱 = []"
              and q'C_empty: "q'  C𝒱 = []"
              and q'_in_E1_union_E2_star: "set q'  (EES1  EES2)"
              unfolding Let_def
              by auto
            
            let ?tau = "τ @ r1 @ q' @ [𝒱']"
           
            from Cons(2) r1_in_E1star q'_in_E1_union_E2_star v'_in_E1 
            have "set ?tau  (E(ES1  ES2))"
              by (simp add: composeES_def, auto)
            moreover
            from Cons(3) have "set lambda'  V𝒱"
              by auto
            moreover
            note s1'_in_E1star
            moreover
            from t2'_in_E2star t2'_is_r2'_v'_s2' have "set s2'  EES2"
              by simp
            moreover
            from q'E1_is_q1' r1_in_E1star v'_in_E1 q1'_in_E1star τE1_r1_q1'_v'_s1'_in_Tr1 
            have "?tau  EES1 @ s1'  TrES1"
              by (simp only: list_subset_iff_projection_neutral 
                projection_concatenation_commute projection_def, auto)
            moreover
            from τr1E2_t2'_in_Tr2 t2'_is_r2'_v'_s2' v'_in_E2 q'E2_is_r2' 
            have "?tau  EES2 @ s2'  TrES2"
              by (simp only: projection_concatenation_commute projection_def, auto)
            moreover
            have "lambda'  EES1 = s1'  V𝒱"
              proof -
                from Cons(3-4) Cons(8) v'_in_E1 have "t1  V𝒱 = [𝒱'] @ (lambda'  EES1)"
                  by (simp add: projection_def)
                moreover
                from t1_is_r1_v'_s1 r1_Vv_empty v'_in_Vv1 Vv_is_Vv1_union_Vv2 
                have "t1  V𝒱 = [𝒱'] @ (s1  V𝒱)"
                  by (simp only: t1_is_r1_v'_s1 projection_concatenation_commute 
                    projection_def, auto)
                moreover
                have "s1  V𝒱 = s1'  V𝒱"
                  using propSepViews unfolding properSeparationOfViews_def
                  by (metis Int_commute  projection_intersection_neutral 
                    s1'Vv1_is_s1_Vv1 s1'_in_E1star s1_in_E1star)    
                ultimately show ?thesis
                  by auto
              qed
            moreover
            have "lambda'  EES2 = s2'  V𝒱"
              proof -
                from Cons(3,5,9)  v'_in_E2 have "t2  V𝒱 = [𝒱'] @ (lambda'  EES2)"
                  by (simp add: projection_def)
                moreover            
                from t2'_is_r2'_v'_s2' r2'_Vv2_empty r2'_in_E2star v'_in_Vv2 propSepViews
                have "t2'  V𝒱 = [𝒱'] @ (s2'  V𝒱)"
                  proof -
                    have "r2'  V𝒱 =[]"   
                      using propSepViews unfolding properSeparationOfViews_def
                      by (metis  projection_on_subset2 r2'_Vv2_empty 
                        r2'_in_E2star subset_iff_psubset_eq)
                    with t2'_is_r2'_v'_s2' v'_in_Vv2 Vv_is_Vv1_union_Vv2 show ?thesis                    
                      by (simp only: t2'_is_r2'_v'_s2' 
                        projection_concatenation_commute projection_def, auto)
                  qed
                moreover
                have "t2  V𝒱 = t2'  V𝒱"
                  using propSepViews unfolding properSeparationOfViews_def
                  by (metis Int_commute  outerCons_prems(4) 
                    projection_intersection_neutral t2'_Vv2_is_t2_Vv2 t2'_in_E2star)
                ultimately show ?thesis
                  by auto
              qed
            moreover
            note s1'Cv1_empty s2'_Cv2_empty Cons.hyps[of ?tau s1' s2']
            ultimately obtain t'
              where τ_r1_q'_v'_t'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
              and t'Vv_is_lambda': "t'  V𝒱 = lambda'"
              and t'Cv_empty: "t'  C𝒱 = []"
              by auto
            
            let ?t = "r1 @ q' @ [𝒱'] @ t'"

            note τ_r1_q'_v'_t'_in_Tr
            moreover
            from r1_Vv_empty q'V_empty t'Vv_is_lambda' v'_in_Vv 
            have "?t  V𝒱 = 𝒱' # lambda'"
              by(simp only: projection_concatenation_commute projection_def, auto)
            moreover
            from VIsViewOnE r1_Cv1_empty t'Cv_empty q'C_empty v'_in_Vv 
            have "?t  C𝒱 = []"
              proof -
                from VIsViewOnE v'_in_Vv have "[𝒱']  C𝒱 = []"
                  by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
                    VN_disjoint_def NC_disjoint_def projection_def, auto)
                moreover
                from r1_in_E1star r1_Cv1_empty  
                have "r1  C𝒱 = []"     
                  using propSepViews projection_on_subset2 
                  unfolding properSeparationOfViews_def by auto
                moreover
                note t'Cv_empty q'C_empty
                ultimately show ?thesis
                  by (simp only: projection_concatenation_commute, auto)
              qed
            ultimately have ?thesis
              by auto
          }
            moreover
            {         
              assume v'_in_Vv1_inter_Vv2_inter_Nabla2: "𝒱'  V𝒱1  V𝒱2 Γ2"
              hence v'_in_Vv1: "𝒱'  V𝒱1" and v'_in_Vv2: "𝒱'  V𝒱2" 
                and v'_in_Nabla2: "𝒱' Γ2"
                by auto
              with v'_in_Vv  propSepViews
              have v'_in_E1: "𝒱'  EES1" and v'_in_E2: "𝒱'  EES2"
                unfolding properSeparationOfViews_def by auto

              from Cons(3,5,9) v'_in_E2 have "t2  V𝒱 = 𝒱' # (lambda'  EES2)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r2 s2 
                where t2_is_r2_v'_s2: "t2 = r2 @ [𝒱'] @ s2"
                and r2_Vv_empty: "r2  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱2" "V𝒱" "r2"]
              have r2_Vv2_empty: "r2  V𝒱2 = []"
                by auto

              from t2_is_r2_v'_s2 Cons(11) have r2_Cv2_empty: "r2  C𝒱2 = []"
                by (simp add: projection_concatenation_commute)

              from t2_is_r2_v'_s2 Cons(11) have s2_Cv2_empty: "s2  C𝒱2 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(5) t2_is_r2_v'_s2 have r2_in_E2star: "set r2  EES2" 
                and s2_in_E2star: "set s2  EES2"
                by auto

              have r2_in_Nv2star: "set r2  N𝒱2"
                proof -
                  note r2_in_E2star
                  moreover
                  from r2_Vv2_empty have "set r2  V𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  from r2_Cv2_empty have "set r2  C𝒱2 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  note validV2
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def  
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                qed
              
              have r2E1_in_Nv2_inter_C1_star: "set (r2  EES1)  (N𝒱2  C𝒱1)"
                proof -
                  have "set (r2  EES1) = set r2  EES1"
                    by (simp add: projection_def, auto)
                  with r2_in_Nv2star have "set (r2  EES1)  (EES1  N𝒱2)"
                    by auto
                  moreover 
                  from validV1  disjoint_Nv2_Vv1 propSepViews
                  have "EES1  N𝒱2 = N𝒱2  C𝒱1"
                    unfolding properSeparationOfViews_def
                    by (simp add: isViewOn_def V_valid_def
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                  ultimately show ?thesis
                    by auto
                qed
              with Cv1_inter_Nv2_subsetof_Upsilon1 
              have r2E1_in_Nv2_inter_C1_Upsilon1_star: "set (r2  EES1)  (N𝒱2  C𝒱1  ΥΓ1)"
                by auto
 
              note outerCons_prems = Cons.prems

              have "set (r2  EES1)  (N𝒱2  C𝒱1)  
                 t1'. ( set t1'  EES1 
                 ((τ @ r2)  EES1) @ t1'  TrES1 
                 t1'  V𝒱1 = t1  V𝒱1 
                 t1'  C𝒱1 = [] )"
              proof (induct "r2  EES1" arbitrary: r2 rule: rev_induct)
                case Nil thus ?case     
                  by (metis append_self_conv outerCons_prems(9) outerCons_prems(3) 
                    outerCons_prems(5) projection_concatenation_commute)
              next
                case (snoc x xs)

                have xs_is_xsE1: "xs = xs  EES1"
                  proof -
                    from snoc(2) have "set (xs @ [x])  EES1"
                      by (simp add: projection_def, auto)
                    hence "set xs  EES1"
                      by auto
                    thus ?thesis
                      by (simp add: list_subset_iff_projection_neutral)
                  qed
                moreover
                have "set (xs  EES1)  (N𝒱2  C𝒱1)"
                  proof -
                    have "set (r2  EES1)  (N𝒱2  C𝒱1)"                      
                      by (metis Int_commute snoc.prems)
                    with snoc(2) have "set (xs @ [x])  (N𝒱2  C𝒱1)"
                      by simp
                    hence "set xs  (N𝒱2  C𝒱1)"
                      by auto
                    with xs_is_xsE1 show ?thesis
                      by auto
                  qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain t1''
                  where t1''_in_E1star: "set t1''  EES1"
                  and τ_xs_E1_t1''_in_Tr1: "((τ @ xs)  EES1) @ t1''  TrES1"
                  and t1''Vv1_is_t1Vv1: "t1''  V𝒱1 = t1  V𝒱1"
                  and t1''Cv1_empty: "t1''  C𝒱1 = []"
                  by auto
                              
                have x_in_Cv1_inter_Nv2: "x  C𝒱1  N𝒱2"
                  proof -
                    from snoc(2-3) have "set (xs @ [x])  (N𝒱2  C𝒱1)"
                      by simp
                    thus ?thesis
                      by auto
                  qed
                hence x_in_Cv1: "x  C𝒱1"
                  by auto
                moreover
                note τ_xs_E1_t1''_in_Tr1 t1''Cv1_empty
                moreover
                have Adm: "(Adm 𝒱1 ρ1 TrES1 ((τ @ xs)  EES1) x)"
                  proof -
                    from τ_xs_E1_t1''_in_Tr1 validES1
                    have τ_xsE1_in_Tr1: "((τ @ xs)  EES1)  TrES1"
                      by (simp add: ES_valid_def traces_prefixclosed_def
                        prefixclosed_def prefix_def)
                    with x_in_Cv1_inter_Nv2 ES1_total_Cv1_inter_Nv2 
                    have τ_xsE1_x_in_Tr1: "((τ @ xs)  EES1) @ [x]  TrES1"
                      by (simp only: total_def)
                    moreover
                    have "((τ @ xs)  EES1)  (ρ1 𝒱1) = ((τ @ xs)  EES1)  (ρ1 𝒱1)" ..
                    ultimately show ?thesis
                      by (simp add: Adm_def, auto)
                  qed
                moreover note BSIA1
                ultimately obtain t1'
                  where res1: "((τ @ xs)  EES1) @ [x] @ t1'  TrES1"
                  and res2: "t1'  V𝒱1 = t1''  V𝒱1"
                  and res3: "t1'  C𝒱1 = []"
                  by (simp only: BSIA_def, blast)

                have "set t1'  EES1"
                  proof -
                    from res1 validES1 have "set (((τ @ xs)  EES1) @ [x] @ t1')  EES1"
                      by (simp add: ES_valid_def traces_contain_events_def, auto)
                    thus ?thesis
                      by auto
                  qed
                moreover 
                have "((τ @ r2)  EES1) @ t1'  TrES1"
                  proof -
                    from res1 xs_is_xsE1 have "((τ  EES1) @ (xs @ [x])) @ t1'  TrES1"
                      by (simp only: projection_concatenation_commute, auto)
                    thus  ?thesis
                      by (simp only: snoc(2) projection_concatenation_commute)
                  qed
                moreover
                from t1''Vv1_is_t1Vv1 res2 have "t1'  V𝒱1 = t1  V𝒱1"
                  by auto
                moreover
                note res3
                ultimately show ?case
                  by auto
              qed
              from this[OF r2E1_in_Nv2_inter_C1_star] obtain t1'
                where t1'_in_E1star: "set t1'  EES1" 
                and τr2E1_t1'_in_Tr1: "((τ @ r2)  EES1) @ t1'  TrES1"
                and t1'_Vv1_is_t1_Vv1: "t1'  V𝒱1 = t1  V𝒱1"
                and t1'_Cv1_empty: "t1'  C𝒱1 = []"
                by auto

              have "t1'  V𝒱1 = 𝒱' # (lambda'  EES1)"
                proof -
                  from projection_intersection_neutral[OF Cons(4), of "V𝒱"] propSepViews 
                  have "t1  V𝒱 = t1  V𝒱1"
                    unfolding properSeparationOfViews_def
                    by (simp only: Int_commute)
                  with Cons(8) t1'_Vv1_is_t1_Vv1 v'_in_E1 show ?thesis
                    by (simp add: projection_def)
                qed
              from projection_split_first[OF this] obtain r1' s1'
                where t1'_is_r1'_v'_s1': "t1' = r1' @ [𝒱'] @ s1'"
                and r1'_Vv1_empty: "r1'  V𝒱1 = []"
                by auto
              
              from t1'_is_r1'_v'_s1' t1'_Cv1_empty have r1'_Cv1_empty: "r1'  C𝒱1 = []"
                by (simp add: projection_concatenation_commute)
              
              from t1'_is_r1'_v'_s1' t1'_Cv1_empty have s1'_Cv1_empty: "s1'  C𝒱1 = []"
                by (simp only: projection_concatenation_commute, auto)
              
              from t1'_in_E1star t1'_is_r1'_v'_s1' have r1'_in_E1star: "set r1'  EES1"
                by auto
              
              have r1'_in_Nv1star: "set r1'  N𝒱1"
                proof - 
                  note r1'_in_E1star
                  moreover
                  from r1'_Vv1_empty have "set r1'  V𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  from r1'_Cv1_empty have "set r1'  C𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  note validV1
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def 
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                qed
            
              have r1'E2_in_Nv1_inter_C2_star: "set (r1'  EES2)  (N𝒱1  C𝒱2)"
                proof -
                  have "set (r1'  EES2) = set r1'  EES2"
                    by (simp add: projection_def, auto)
                  with r1'_in_Nv1star have "set (r1'  EES2)  (EES2  N𝒱1)"
                    by auto
                  moreover 
                  from validV2 propSepViews disjoint_Nv1_Vv2 
                  have "EES2  N𝒱1 = N𝒱1  C𝒱2"
                    unfolding properSeparationOfViews_def
                    by (simp add: isViewOn_def V_valid_def 
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                  ultimately show ?thesis
                    by auto
                qed
              with Cv2_inter_Nv1_subsetof_Upsilon2 
              have r1'E2_in_Nv1_inter_Cv2_Upsilon2_star: 
                "set (r1'  EES2)  (N𝒱1  C𝒱2  ΥΓ2)"
                by auto            

              have "set (r1'  EES2)  (N𝒱1  C𝒱2  ΥΓ2) 
                 s2' q2'. (
                set s2'  EES2  set q2'  C𝒱2  ΥΓ2  N𝒱2  ΔΓ2 
                 (τ  EES2) @ r2 @ q2' @ [𝒱'] @ s2'  TrES2
                 q2'  (C𝒱2  ΥΓ2) = r1'  EES2
                 s2'  V𝒱2 = s2  V𝒱2
                 s2'  C𝒱2 = [])"              
              proof (induct "r1'  EES2" arbitrary: r1' rule: rev_induct)
                case Nil

                note s2_in_E2star
                moreover
                have "set []  C𝒱2  ΥΓ2  N𝒱2  ΔΓ2"
                  by auto
                moreover
                from outerCons_prems(6) t2_is_r2_v'_s2 
                have "τ  EES2 @ r2 @ [] @ [𝒱'] @ s2  TrES2"
                  by auto
                moreover
                from Nil have "[]  (C𝒱2  ΥΓ2) = r1'  EES2"
                  by (simp add: projection_def)
                moreover
                have "s2  V𝒱2 = s2  V𝒱2"..
                moreover
                note s2_Cv2_empty
                ultimately show ?case
                  by blast
                
              next
                case (snoc x xs)

                have xs_is_xsE2: "xs = xs  EES2"
                  proof -
                    from snoc(2) have "set (xs @ [x])  EES2"
                      by (simp add: projection_def, auto)
                    thus ?thesis
                      by (simp add: list_subset_iff_projection_neutral)
                  qed
                moreover
                have "set (xs  EES2)  N𝒱1  C𝒱2  ΥΓ2"
                  proof -
                    from snoc(2-3) have "set (xs @ [x])  N𝒱1  C𝒱2  ΥΓ2"
                      by simp
                    with xs_is_xsE2 show ?thesis
                      by auto
                  qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain s2'' q2'' 
                  where s2''_in_E2star: "set s2''  EES2"
                  and q2''_in_C2_inter_Upsilon2_inter_Delta2: "set q2''  C𝒱2  ΥΓ2  N𝒱2  ΔΓ2"
                  and τE2_r2_q2''_v'_s2''_in_Tr2: "(τ  EES2 @ r2 @ q2'') @ [𝒱'] @ s2''  TrES2"
                  and q2''C2_Upsilon2_is_xsE2: "q2''  (C𝒱2  ΥΓ2) = xs  EES2"
                  and s2''V2_is_s2V2: "s2''  V𝒱2 = s2  V𝒱2" 
                  and s2''C2_empty: "s2''  C𝒱2 = []"
                  by auto
                
                have x_in_Cv2_inter_Upsilon2: "x  C𝒱2  ΥΓ2" 
                  and x_in_Cv2_inter_Nv1: "x  C𝒱2  N𝒱1"
                  proof -
                    from snoc(2-3) have "set (xs @ [x])  (N𝒱1  C𝒱2  ΥΓ2)"
                      by simp
                    thus "x  C𝒱2  ΥΓ2" 
                      and  "x  C𝒱2  N𝒱1"
                      by auto
                  qed
                with validV2 have x_in_E2: "x  EES2"
                  by (simp add:isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)

                note x_in_Cv2_inter_Upsilon2
                moreover
                from v'_in_Vv1_inter_Vv2_inter_Nabla2 have "𝒱'  V𝒱2 Γ2"
                  by auto
                moreover
                note τE2_r2_q2''_v'_s2''_in_Tr2 s2''C2_empty
                moreover
                have Adm: "(Adm 𝒱2 ρ2 TrES2 (τ  EES2 @ r2 @ q2'') x)"
                  proof -
                    from τE2_r2_q2''_v'_s2''_in_Tr2 validES2
                    have "(τ  EES2 @ r2 @ q2'')  TrES2"
                      by (simp add: ES_valid_def traces_prefixclosed_def
                        prefixclosed_def prefix_def)                   
                    with x_in_Cv2_inter_Nv1 ES2_total_Cv2_inter_Nv1 
                    have "(τ  EES2 @ r2 @ q2'') @ [x]  TrES2"
                      by (simp only: total_def)
                    moreover
                    have "(τ  EES2 @ r2 @ q2'')  (ρ2 𝒱2) = (τ  EES2 @ r2 @ q2'')  (ρ2 𝒱2)" ..
                    ultimately show ?thesis
                      by (simp only: Adm_def, blast)
                  qed
                moreover 
                note FCIA2  
                ultimately
                obtain s2' γ'
                  where res1: "(set γ')  (N𝒱2  ΔΓ2)"
                  and res2: "((τ  EES2 @ r2 @ q2'') @ [x] @ γ' @ [𝒱'] @ s2')  TrES2"
                  and res3: "(s2'  V𝒱2) = (s2''  V𝒱2)"
                  and res4: "s2'  C𝒱2 = []"
                  unfolding FCIA_def
                  by blast
                 
                let ?q2' = "q2'' @ [x] @ γ'"

                from res2 validES2 have "set s2'  EES2"
                  by (simp add: ES_valid_def traces_contain_events_def, auto)
                moreover
                from res1 x_in_Cv2_inter_Upsilon2 q2''_in_C2_inter_Upsilon2_inter_Delta2 
                have "set ?q2'  C𝒱2  ΥΓ2  N𝒱2  ΔΓ2"
                  by auto
                moreover
                from res2 have "τ  EES2 @ r2 @ ?q2' @ [𝒱'] @ s2'  TrES2"
                  by auto
                moreover
                have "?q2'  (C𝒱2  ΥΓ2) = r1'  EES2"
                  proof -
                    from validV2 res1 have "γ'  (C𝒱2  ΥΓ2) = []"
                      proof -
                        from res1 have "γ' = γ'  (N𝒱2  ΔΓ2)"
                          by (simp only: list_subset_iff_projection_neutral)
                        hence "γ'  (C𝒱2  ΥΓ2) = γ'  (N𝒱2  ΔΓ2)  (C𝒱2  ΥΓ2)"
                          by simp
                        hence "γ'  (C𝒱2  ΥΓ2) = γ'  (N𝒱2  ΔΓ2  C𝒱2  ΥΓ2)"
                          by (simp only: projection_def, auto)
                        moreover
                        from validV2 have "N𝒱2  ΔΓ2  C𝒱2  ΥΓ2 = {}"
                          by (simp add:isViewOn_def V_valid_def 
                            VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                        ultimately show ?thesis
                          by (simp add: projection_def)
                      qed
                    hence "?q2'  (C𝒱2  ΥΓ2) = (q2'' @ [x])  (C𝒱2  ΥΓ2)"
                      by (simp only: projection_concatenation_commute, auto)
                    with q2''C2_Upsilon2_is_xsE2 x_in_Cv2_inter_Upsilon2 
                    have "?q2'  (C𝒱2  ΥΓ2) = (xs  EES2) @ [x]"
                      by (simp only: projection_concatenation_commute projection_def, auto)
                    with xs_is_xsE2 snoc(2) show ?thesis
                      by simp
                  qed
                moreover
                from res3 s2''V2_is_s2V2 have "s2'  V𝒱2 = s2  V𝒱2"
                  by simp
                moreover
                note res4
                ultimately show ?case 
                  by blast
              qed
            from this[OF r1'E2_in_Nv1_inter_Cv2_Upsilon2_star] obtain s2' q2' 
              where s2'_in_E2star: "set s2'  EES2"
              and q2'_in_Cv2_inter_Upsilon2_union_Nv2_inter_Delta2: 
              "set q2'  C𝒱2  ΥΓ2  N𝒱2  ΔΓ2" 
              and τE2_r2_q2'_v'_s2'_in_Tr2: "(τ  EES2) @ r2 @ q2' @ [𝒱'] @ s2'  TrES2"
              and q2'Cv2_inter_Upsilon2_is_r1'E2: "q2'  (C𝒱2  ΥΓ2) = r1'  EES2"
              and s2'Vv2_is_s2_Vv2: "s2'  V𝒱2 = s2  V𝒱2"
              and s2'Cv2_empty: "s2'  C𝒱2 = []"
              by auto

            from q2'_in_Cv2_inter_Upsilon2_union_Nv2_inter_Delta2 validV2 
            have q2'_in_E2star: "set q2'  EES2"
              by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
                VN_disjoint_def NC_disjoint_def, auto)
          
            have r1'Cv_empty: "r1'  C𝒱 = []"
              using propSepViews unfolding properSeparationOfViews_def
              by (metis  projection_on_subset2 
                r1'_Cv1_empty r1'_in_E1star)  

            (* application of merge_property' *)
            from validES2 τE2_r2_q2'_v'_s2'_in_Tr2 
            have q2'_in_E2star: "set q2'  EES2"
              by (simp add: ES_valid_def traces_contain_events_def, auto)
            moreover
            note r1'_in_E1star
            moreover
            have q2'E1_is_r1'E2: "q2'  EES1 = r1'  EES2"
              proof -
                from q2'_in_Cv2_inter_Upsilon2_union_Nv2_inter_Delta2 
                have "q2'  (C𝒱2  ΥΓ2  N𝒱2  ΔΓ2) = q2'"
                  by (simp add: list_subset_iff_projection_neutral)
                hence "(q2'  (C𝒱2  ΥΓ2  N𝒱2  ΔΓ2))  EES1 = q2'  EES1"
                  by simp
                hence "q2'  ((C𝒱2  ΥΓ2  N𝒱2  ΔΓ2)  EES1) = q2'  EES1"
                  by (simp add: projection_def)
                hence "q2'  (C𝒱2  ΥΓ2  EES1) = q2'  EES1"
                  by (simp only: Int_Un_distrib2 disjoint_Nv2_inter_Delta2_inter_E1, auto)
                moreover
                from q2'Cv2_inter_Upsilon2_is_r1'E2 
                have "(q2'  (C𝒱2  ΥΓ2))  EES1 = (r1'  EES2)  EES1"
                  by simp
                hence "q2'  (C𝒱2  ΥΓ2  EES1) = (r1'  EES1)  EES2"
                  by (simp add: projection_def conj_commute)
                with r1'_in_E1star have "q2'  (C𝒱2  ΥΓ2  EES1) = r1'  EES2"
                  by (simp only: list_subset_iff_projection_neutral)
                ultimately show ?thesis
                  by auto
              qed  
            moreover
            have "q2'  V𝒱 = []"
              proof -
                from q2'_in_Cv2_inter_Upsilon2_union_Nv2_inter_Delta2 
                have "q2' = q2'  (C𝒱2  ΥΓ2  N𝒱2  ΔΓ2)"
                  by (simp add: list_subset_iff_projection_neutral)
                moreover
                from q2'_in_E2star have "q2' = q2'  EES2"
                  by (simp add: list_subset_iff_projection_neutral)
                ultimately have "q2' = q2'  (C𝒱2  ΥΓ2  N𝒱2  ΔΓ2)  EES2"
                  by simp
                hence "q2'  V𝒱 = q2'  (C𝒱2  ΥΓ2  N𝒱2  ΔΓ2)  EES2  V𝒱"
                  by simp
                hence "q2'  V𝒱 = q2'  (C𝒱2  ΥΓ2  N𝒱2  ΔΓ2)  (V𝒱  EES2)"
                  by (simp add: Int_commute projection_def)
                with propSepViews
                have "q2'  V𝒱 = q2'  ((C𝒱2  ΥΓ2  N𝒱2  ΔΓ2)  V𝒱2)"
                  unfolding properSeparationOfViews_def
                  by (simp add: projection_def)
                hence "q2'  V𝒱 = q2'  (V𝒱2  C𝒱2  ΥΓ2  V𝒱2  N𝒱2  ΔΓ2)"              
                  by (simp add: Int_Un_distrib2, metis Int_assoc 
                    Int_commute Int_left_commute Un_commute)
                with validV2 show ?thesis
                  by (simp add: isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto, simp add: projection_def)
              qed
            moreover
            have "r1'  V𝒱 = []"
              using propSepViews unfolding properSeparationOfViews_def
              by (metis Int_commute  projection_intersection_neutral 
                r1'_Vv1_empty r1'_in_E1star)
            moreover
            have q2'Cv_empty: "q2'  C𝒱 = []"
              proof - 
                from q2'_in_E2star have foo: "q2' = q2'  EES2"
                  by (simp add: list_subset_iff_projection_neutral)
                hence "q2'  C𝒱 = q2'  (C𝒱  EES2)"
                  by (metis Int_commute list_subset_iff_projection_neutral 
                    projection_intersection_neutral)
                moreover
                from propSepViews have "C𝒱  EES2  C𝒱2"
                  unfolding properSeparationOfViews_def by auto
                from projection_subset_elim[OF ‹C𝒱  EES2  C𝒱2, of q2'] 
                have "q2'  C𝒱2  C𝒱  EES2 = q2'  (C𝒱  EES2)"
                  by (simp add: projection_def)
                hence "q2'  EES2  C𝒱2  C𝒱 = q2'  (C𝒱  EES2)"
                  by (simp add: projection_commute)
                with foo have "q2'  (C𝒱2  C𝒱) = q2'  (C𝒱  EES2)"
                  by (simp add: projection_def)
                moreover
                from q2'_in_Cv2_inter_Upsilon2_union_Nv2_inter_Delta2 
                have "q2'  (C𝒱2  C𝒱) = q2'  (C𝒱2  ΥΓ2  N𝒱2  ΔΓ2)  (C𝒱2  C𝒱)"
                  by (simp add: list_subset_iff_projection_neutral)
                moreover
                have "(C𝒱2  ΥΓ2  N𝒱2  ΔΓ2)  (C𝒱2  C𝒱) 
                    = (C𝒱2  ΥΓ2  C𝒱2  N𝒱2  ΔΓ2)  C𝒱"
                  by fast
                hence "q2'  (C𝒱2  ΥΓ2  N𝒱2  ΔΓ2)  (C𝒱2  C𝒱) 
                  = q2'  (C𝒱2  ΥΓ2  C𝒱2  N𝒱2  ΔΓ2)  C𝒱"
                  by (simp add: projection_sequence)
                moreover
                from validV2 
                have "q2'  (C𝒱2  ΥΓ2  C𝒱2  N𝒱2  ΔΓ2)  C𝒱
                  = q2'  (C𝒱2  ΥΓ2)  C𝒱"
                  by (simp add: isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def Int_commute)
                moreover
                from q2'Cv2_inter_Upsilon2_is_r1'E2 
                have "q2'  (C𝒱2  ΥΓ2)  C𝒱 = r1'  EES2  C𝒱"
                  by simp
                with projection_on_intersection[OF r1'Cv_empty] have "q2'  (C𝒱2  ΥΓ2)  C𝒱 = []"
                  by (simp add: Int_commute projection_def)
                ultimately show ?thesis
                  by auto           
              qed
            moreover
            note r1'Cv_empty merge_property'[of r1' q2']
            ultimately obtain q'
              where q'E2_is_q2': "q'  EES2 = q2'"
              and q'E1_is_r1': "q'  EES1 = r1'"
              and q'V_empty: "q'  V𝒱 = []"
              and q'C_empty: "q'  C𝒱 = []"
              and q'_in_E1_union_E2_star: "set q'  (EES1  EES2)"
              unfolding Let_def
              by auto
            
            let ?tau = "τ @ r2 @ q' @ [𝒱']"
           
            from Cons(2) r2_in_E2star q'_in_E1_union_E2_star v'_in_E2 
            have "set ?tau  (E(ES1  ES2))"
              by (simp add: composeES_def, auto)
            moreover
            from Cons(3) have "set lambda'  V𝒱"
              by auto
            moreover
            from t1'_in_E1star t1'_is_r1'_v'_s1' have "set s1'  EES1"
              by simp
            moreover
            note s2'_in_E2star
            moreover
            from τr2E1_t1'_in_Tr1 t1'_is_r1'_v'_s1' v'_in_E1 q'E1_is_r1' 
            have "?tau  EES1 @ s1'  TrES1"
              by (simp only: projection_concatenation_commute projection_def, auto)
            moreover
            from q'E2_is_q2' r2_in_E2star v'_in_E2 q2'_in_E2star τE2_r2_q2'_v'_s2'_in_Tr2 
            have "?tau  EES2 @ s2'  TrES2"
              by (simp only: list_subset_iff_projection_neutral 
                projection_concatenation_commute projection_def, auto)
            moreover
            have "lambda'  EES1 = s1'  V𝒱"
              proof -
                from Cons(2,4,8)  v'_in_E1 have "t1  V𝒱 = [𝒱'] @ (lambda'  EES1)"
                  by (simp add: projection_def)
                moreover            
                from t1'_is_r1'_v'_s1' r1'_Vv1_empty r1'_in_E1star 
                  v'_in_Vv1 propSepViews
                have "t1'  V𝒱 = [𝒱'] @ (s1'  V𝒱)"
                  proof -
                    have "r1'  V𝒱 =[]"
                      using propSepViews unfolding properSeparationOfViews_def
                      by (metis  projection_on_subset2 r1'_Vv1_empty 
                        r1'_in_E1star subset_iff_psubset_eq)
                    with t1'_is_r1'_v'_s1' v'_in_Vv1 Vv_is_Vv1_union_Vv2 show ?thesis                    
                      by (simp only: t1'_is_r1'_v'_s1' projection_concatenation_commute 
                        projection_def, auto)
                  qed
                moreover
                have "t1  V𝒱 = t1'  V𝒱"
                  using propSepViews unfolding properSeparationOfViews_def
                  by (metis Int_commute outerCons_prems(3) 
                    projection_intersection_neutral t1'_Vv1_is_t1_Vv1 t1'_in_E1star)
                ultimately show ?thesis
                  by auto
              qed
            moreover
            have "lambda'  EES2 = s2'  V𝒱"
              proof -
                from Cons(3,5,9) v'_in_E2 have "t2  V𝒱 = [𝒱'] @ (lambda'  EES2)"
                  by (simp add: projection_def)
                moreover
                from t2_is_r2_v'_s2 r2_Vv_empty v'_in_Vv2 Vv_is_Vv1_union_Vv2 
                have "t2  V𝒱 = [𝒱'] @ (s2  V𝒱)"
                  by (simp only: t2_is_r2_v'_s2 projection_concatenation_commute 
                    projection_def, auto)
                moreover
                have "s2  V𝒱 = s2'  V𝒱" 
                  using propSepViews unfolding properSeparationOfViews_def
                  by (metis Int_commute  projection_intersection_neutral 
                    s2'Vv2_is_s2_Vv2 s2'_in_E2star s2_in_E2star)    
                ultimately show ?thesis
                  by auto
              qed
            moreover
            note s1'_Cv1_empty s2'Cv2_empty Cons.hyps[of ?tau s1' s2']
            ultimately obtain t'
              where τ_r2_q'_v'_t'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
              and t'Vv_is_lambda': "t'  V𝒱 = lambda'"
              and t'Cv_empty: "t'  C𝒱 = []"
              by auto
            
            let ?t = "r2 @ q' @ [𝒱'] @ t'"

            note τ_r2_q'_v'_t'_in_Tr
            moreover
            from r2_Vv_empty q'V_empty t'Vv_is_lambda' v'_in_Vv 
            have "?t  V𝒱 = 𝒱' # lambda'"
              by(simp only: projection_concatenation_commute projection_def, auto)
            moreover
            from VIsViewOnE r2_Cv2_empty t'Cv_empty q'C_empty v'_in_Vv 
            have "?t  C𝒱 = []"
              proof -
                from VIsViewOnE v'_in_Vv have "[𝒱']  C𝒱 = []"
                  by (simp add: isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def projection_def, auto)
                moreover
                from r2_in_E2star r2_Cv2_empty 
                have "r2  C𝒱 = []"     
                  using propSepViews projection_on_subset2 unfolding properSeparationOfViews_def 
                  by auto
                moreover
                note t'Cv_empty q'C_empty
                ultimately show ?thesis
                  by (simp only: projection_concatenation_commute, auto)
              qed
            ultimately have ?thesis
              by auto
            }
            moreover
            {
              assume v'_in_Vv1_minus_E2: "𝒱'  V𝒱1 - EES2"
              hence v'_in_Vv1: "𝒱'  V𝒱1"
                by auto
              with v'_in_Vv  have v'_in_E1: "𝒱'  EES1" 
                using propSepViews unfolding properSeparationOfViews_def
                by auto

              from v'_in_Vv1_minus_E2 have v'_notin_E2: "𝒱'  EES2"
                by auto
              with validV2 have v'_notin_Vv2: "𝒱'  V𝒱2"
                by (simp add: isViewOn_def V_valid_def 
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)

              from Cons(3-4) Cons(8) v'_in_E1 have "t1  V𝒱 = 𝒱' # (lambda'  EES1)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r1 s1 
                where t1_is_r1_v'_s1: "t1 = r1 @ [𝒱'] @ s1"
                and r1_Vv_empty: "r1  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱1" "V𝒱" "r1"]
              have r1_Vv1_empty: "r1  V𝒱1 = []"
                by auto

              from t1_is_r1_v'_s1 Cons(10) have r1_Cv1_empty: "r1  C𝒱1 = []"
                by (simp add: projection_concatenation_commute)

              from t1_is_r1_v'_s1 Cons(10) have s1_Cv1_empty: "s1  C𝒱1 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(4) t1_is_r1_v'_s1 have r1_in_E1star: "set r1  EES1"
                by auto

              have r1_in_Nv1star: "set r1  N𝒱1"
                proof -
                  note r1_in_E1star
                  moreover
                  from r1_Vv1_empty have "set r1  V𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral
                      projection_on_union)
                  moreover
                  from r1_Cv1_empty have "set r1  C𝒱1 = {}"
                    by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                      disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                      projection_on_union)
                  moreover
                  note validV1
                  ultimately show ?thesis
                    by (simp add: isViewOn_def V_valid_def
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                qed
              
              have r1E2_in_Nv1_inter_C2_star: "set (r1  EES2)  (N𝒱1  C𝒱2)"
                proof -
                  have "set (r1  EES2) = set r1  EES2"
                    by (simp add: projection_def, auto)
                  with r1_in_Nv1star have "set (r1  EES2)  (EES2  N𝒱1)"
                    by auto
                  moreover 
                  from validV2  disjoint_Nv1_Vv2 
                  have "EES2  N𝒱1 = N𝒱1  C𝒱2"
                    using propSepViews unfolding properSeparationOfViews_def
                    by (simp add: isViewOn_def V_valid_def 
                      VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                  ultimately show ?thesis
                    by auto
                qed
              with Cv2_inter_Nv1_subsetof_Upsilon2 
              have r1E2_in_Nv1_inter_C2_Upsilon2_star: "set (r1  EES2)  (N𝒱1  C𝒱2  ΥΓ2)"
                by auto

              note outerCons_prems = Cons.prems

              have "set (r1  EES2)  (N𝒱1  C𝒱2)  
                 t2'. ( set t2'  EES2 
                 ((τ @ r1)  EES2) @ t2'  TrES2 
                 t2'  V𝒱2 = t2  V𝒱2 
                 t2'  C𝒱2 = [] )"
              proof (induct "r1  EES2" arbitrary: r1 rule: rev_induct)
                case Nil thus ?case          
                  by (metis append_self_conv outerCons_prems(10) outerCons_prems(4) 
                    outerCons_prems(6) projection_concatenation_commute)
              next
                case (snoc x xs)

                have xs_is_xsE2: "xs = xs  EES2"
                  proof -
                    from snoc(2) have "set (xs @ [x])  EES2"
                      by (simp add: projection_def, auto)
                    hence "set xs  (EES2)"
                      by auto
                    thus ?thesis
                      by (simp add: list_subset_iff_projection_neutral)
                  qed
                moreover
                have "set (xs  EES2)  (N𝒱1  C𝒱2)"
                  proof -
                    have "set (r1  EES2)  (N𝒱1  C𝒱2)"                      
                      by (metis Int_commute snoc.prems)
                    with snoc(2) have "set (xs @ [x])  (N𝒱1  C𝒱2)"
                      by simp
                    hence "set xs  (N𝒱1  C𝒱2)"
                      by auto
                    with xs_is_xsE2 show ?thesis
                      by auto
                  qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain t2''
                  where t2''_in_E2star: "set t2''  EES2"
                  and τ_xs_E2_t2''_in_Tr2: "((τ @ xs)  EES2) @ t2''  TrES2"
                  and t2''Vv2_is_t2Vv2: "t2''  V𝒱2 = t2  V𝒱2"
                  and t2''Cv2_empty: "t2''  C𝒱2 = []"
                  by auto
                              
                have x_in_Cv2_inter_Nv1: "x  C𝒱2  N𝒱1"
                  proof -
                    from snoc(2-3) have "set (xs @ [x])  (N𝒱1  C𝒱2)"
                      by simp
                    thus ?thesis
                      by auto
                  qed
                hence x_in_Cv2: "x  C𝒱2"
                  by auto
                moreover
                note τ_xs_E2_t2''_in_Tr2 t2''Cv2_empty
                moreover
                have Adm: "(Adm 𝒱2 ρ2 TrES2 ((τ @ xs)  EES2) x)"
                  proof -
                    from τ_xs_E2_t2''_in_Tr2 validES2
                    have τ_xsE2_in_Tr2: "((τ @ xs)  EES2)  TrES2"
                      by (simp add: ES_valid_def traces_prefixclosed_def
                        prefixclosed_def prefix_def)
                    with x_in_Cv2_inter_Nv1 ES2_total_Cv2_inter_Nv1 
                    have τ_xsE2_x_in_Tr2: "((τ @ xs)  EES2) @ [x]  TrES2"
                      by (simp only: total_def)
                    moreover
                    have "((τ @ xs)  EES2)  (ρ2 𝒱2) = ((τ @ xs)  EES2)  (ρ2 𝒱2)" ..
                    ultimately show ?thesis
                      by (simp add: Adm_def, auto)
                  qed
                moreover note BSIA2
                ultimately obtain t2'
                  where res1: "((τ @ xs)  EES2) @ [x] @ t2'  TrES2"
                  and res2: "t2'  V𝒱2 = t2''  V𝒱2"
                  and res3: "t2'  C𝒱2 = []"
                  by (simp only: BSIA_def, blast)

                have "set t2'  EES2"
                  proof -
                    from res1 validES2 have "set (((τ @ xs)  EES2) @ [x] @ t2')  EES2"
                      by (simp add: ES_valid_def traces_contain_events_def, auto)
                    thus ?thesis
                      by auto
                  qed
                moreover 
                have "((τ @ r1)  EES2) @ t2'  TrES2"
                  proof -
                    from res1 xs_is_xsE2 have "((τ  EES2) @ (xs @ [x])) @ t2'  TrES2"
                      by (simp only: projection_concatenation_commute, auto)
                    thus  ?thesis
                      by (simp only: snoc(2) projection_concatenation_commute)
                  qed
                moreover
                from t2''Vv2_is_t2Vv2 res2 have "t2'  V𝒱2 = t2  V𝒱2"
                  by auto
                moreover
                note res3
                ultimately show ?case
                  by auto
              qed
            from this[OF r1E2_in_Nv1_inter_C2_star] obtain t2'
              where t2'_in_E2star: "set t2'  EES2" 
                and τr1E2_t2'_in_Tr2: "((τ @ r1)  EES2) @ t2'  TrES2"
                and t2'_Vv2_is_t2_Vv2: "t2'  V𝒱2 = t2  V𝒱2"
                and t2'_Cv2_empty: "t2'  C𝒱2 = []"
              by auto
            
            let ?tau = "τ @ r1 @ [𝒱']"
            
            from v'_in_E1 Cons(2) r1_in_Nv1star validV1 have "set ?tau  E(ES1  ES2)"
              by (simp only: isViewOn_def composeES_def V_valid_def
                VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
            moreover
            from Cons(3) have "set lambda'  V𝒱"
              by auto
            moreover
            from Cons(4) t1_is_r1_v'_s1 have "set s1  EES1"
              by auto
            moreover
            note t2'_in_E2star
            moreover
            have "?tau  EES1 @ s1  TrES1"              
              by (metis Cons_eq_appendI append_eq_appendI calculation(3) eq_Nil_appendI 
                list_subset_iff_projection_neutral Cons.prems(3) Cons.prems(5) 
                projection_concatenation_commute t1_is_r1_v'_s1)
            moreover
            from τr1E2_t2'_in_Tr2 v'_notin_E2 have "?tau  EES2 @ t2'  TrES2"
              by (simp add: projection_def)
            moreover
            from Cons(8) t1_is_r1_v'_s1 r1_Vv_empty v'_in_E1 v'_in_Vv have "lambda'  EES1 = s1  V𝒱"
              by (simp add: projection_def)
            moreover
            from Cons(9) v'_notin_E2 t2'_Vv2_is_t2_Vv2 have "lambda'  EES2 = t2'  V𝒱"         
              proof -
                have "t2'  V𝒱 = t2'  V𝒱2" 
                  using propSepViews unfolding properSeparationOfViews_def                 
                  by (simp add: projection_def, metis Int_commute  
                    projection_def projection_intersection_neutral t2'_in_E2star)
                moreover
                have "t2  V𝒱 = t2  V𝒱2"    
                  using propSepViews unfolding properSeparationOfViews_def     
                  by (simp add: projection_def, metis Int_commute 
                    projection_def projection_intersection_neutral Cons(5))
                moreover
                note Cons(9) v'_notin_E2 t2'_Vv2_is_t2_Vv2
                ultimately show ?thesis
                  by (simp add: projection_def)
              qed
            moreover
            note s1_Cv1_empty t2'_Cv2_empty
            moreover
            note Cons.hyps(1)[of ?tau s1 t2']
            ultimately obtain t'
              where τr1v't'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
              and t'_Vv_is_lambda': "t'  V𝒱 = lambda'"
              and t'_Cv_empty: "t'  C𝒱 = []"
              by auto

            let ?t = "r1 @ [𝒱'] @ t'"

            note τr1v't'_in_Tr
            moreover
            from r1_Vv_empty t'_Vv_is_lambda' v'_in_Vv have "?t  V𝒱 = 𝒱' # lambda'"
              by (simp add: projection_def)
            moreover
            have "?t  C𝒱 = []"
              proof -
                have "r1  C𝒱 = []"
                proof -
                  from propSepViews have "EES1  C𝒱  C𝒱1" 
                    unfolding properSeparationOfViews_def by auto
                    from projection_on_subset[OF ‹EES1  C𝒱  C𝒱1 r1_Cv1_empty] 
                    have "r1  (EES1  C𝒱) = []"
                      by (simp only: Int_commute)
                    with projection_intersection_neutral[OF r1_in_E1star, of "C𝒱"] show ?thesis
                      by simp
                  qed
                with v'_in_Vv VIsViewOnE t'_Cv_empty show ?thesis
                  by (simp add: isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def projection_def, auto)
              qed
            ultimately have ?thesis
              by auto
            }
            moreover
            {
              assume v'_in_Vv2_minus_E1: "𝒱'  V𝒱2 - EES1"
              hence v'_in_Vv2: "𝒱'  V𝒱2"
                by auto
              with v'_in_Vv propSepViews have v'_in_E2: "𝒱'  EES2"
                unfolding properSeparationOfViews_def
                by auto

              from v'_in_Vv2_minus_E1 have v'_notin_E1: "𝒱'  EES1"
                by auto
              with validV1 have v'_notin_Vv1: "𝒱'  V𝒱1"
                by (simp add: isViewOn_def V_valid_def
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)

              from Cons(3) Cons(5) Cons(9) v'_in_E2 have "t2  V𝒱 = 𝒱' # (lambda'  EES2)"
                by (simp add: projection_def)
              from projection_split_first[OF this] obtain r2 s2 
                where t2_is_r2_v'_s2: "t2 = r2 @ [𝒱'] @ s2"
                and r2_Vv_empty: "r2  V𝒱 = []"
                by auto
              with Vv_is_Vv1_union_Vv2 projection_on_subset[of "V𝒱2" "V𝒱" "r2"]
              have r2_Vv2_empty: "r2  V𝒱2 = []"
                by auto

              from t2_is_r2_v'_s2 Cons(11) have r2_Cv2_empty: "r2  C𝒱2 = []"
                by (simp add: projection_concatenation_commute)

              from t2_is_r2_v'_s2 Cons(11) have s2_Cv2_empty: "s2  C𝒱2 = []"
                by (simp only: projection_concatenation_commute, auto)

              from Cons(5) t2_is_r2_v'_s2 have r2_in_E2star: "set r2  EES2"
                by auto

              have r2_in_Nv2star: "set r2  N𝒱2"
              proof -
                note r2_in_E2star
                moreover
                from r2_Vv2_empty have "set r2  V𝒱2 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                    disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                    projection_on_union)
                moreover
                from r2_Cv2_empty have "set r2  C𝒱2 = {}"
                  by (metis Compl_Diff_eq Diff_cancel Un_upper2 
                    disjoint_eq_subset_Compl list_subset_iff_projection_neutral 
                    projection_on_union)
                moreover
                note validV2
                ultimately show ?thesis
                  by (simp add: isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
              qed
              
              have r2E1_in_Nv2_inter_C1_star: "set (r2  EES1)  (N𝒱2  C𝒱1)"
              proof -
                have "set (r2  EES1) = set r2  EES1"
                  by (simp add: projection_def, auto)
                with r2_in_Nv2star have "set (r2  EES1)  (EES1  N𝒱2)"
                  by auto
                moreover 
                from validV1 propSepViews disjoint_Nv2_Vv1 
                have "EES1  N𝒱2 = N𝒱2  C𝒱1"
                  unfolding properSeparationOfViews_def
                  by (simp add: isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                ultimately show ?thesis
                  by auto
              qed
              with Cv1_inter_Nv2_subsetof_Upsilon1 
              have r2E1_in_Nv2_inter_C1_Upsilon1_star: "set (r2  EES1)  (N𝒱2  C𝒱1  ΥΓ1)"
                by auto

              note outerCons_prems = Cons.prems

              have "set (r2  EES1)  (N𝒱2  C𝒱1)  
                 t1'. ( set t1'  EES1 
                 ((τ @ r2)  EES1) @ t1'  TrES1 
                 t1'  V𝒱1 = t1  V𝒱1 
                 t1'  C𝒱1 = [] )"
              proof (induct "r2  EES1" arbitrary: r2 rule: rev_induct)
                case Nil thus ?case 
                  by (metis append_self_conv outerCons_prems(9) outerCons_prems(3) 
                    outerCons_prems(5) projection_concatenation_commute)
              next
                case (snoc x xs)

                have xs_is_xsE1: "xs = xs  EES1"
                proof -
                  from snoc(2) have "set (xs @ [x])  EES1"
                    by (simp add: projection_def, auto)
                  hence "set xs  EES1"
                    by auto
                  thus ?thesis
                    by (simp add: list_subset_iff_projection_neutral)
                qed
                moreover
                have "set (xs  EES1)  (N𝒱2  C𝒱1)"
                proof -
                  have "set (r2  EES1)  (N𝒱2  C𝒱1)"                      
                    by (metis Int_commute snoc.prems)
                  with snoc(2) have "set (xs @ [x])  (N𝒱2  C𝒱1)"
                    by simp
                  hence "set xs  (N𝒱2  C𝒱1)"
                    by auto
                  with xs_is_xsE1 show ?thesis
                    by auto
                qed
                moreover
                note snoc.hyps(1)[of xs]
                ultimately obtain t1''
                  where t1''_in_E1star: "set t1''  EES1"
                  and τ_xs_E1_t1''_in_Tr1: "((τ @ xs)  EES1) @ t1''  TrES1"
                  and t1''Vv1_is_t1Vv1: "t1''  V𝒱1 = t1  V𝒱1"
                  and t1''Cv1_empty: "t1''  C𝒱1 = []"
                  by auto
                
                have x_in_Cv1_inter_Nv2: "x  C𝒱1  N𝒱2"
                proof -
                  from snoc(2-3) have "set (xs @ [x])  (N𝒱2  C𝒱1)"
                    by simp
                  thus ?thesis
                    by auto
                qed
                hence x_in_Cv1: "x  C𝒱1"
                  by auto
                moreover
                note τ_xs_E1_t1''_in_Tr1 t1''Cv1_empty
                moreover
                have Adm: "(Adm 𝒱1 ρ1 TrES1 ((τ @ xs)  EES1) x)"
                proof -
                  from τ_xs_E1_t1''_in_Tr1 validES1
                  have τ_xsE1_in_Tr1: "((τ @ xs)  EES1)  TrES1"
                    by (simp add: ES_valid_def traces_prefixclosed_def
                      prefixclosed_def prefix_def)
                  with x_in_Cv1_inter_Nv2 ES1_total_Cv1_inter_Nv2 
                  have τ_xsE1_x_in_Tr1: "((τ @ xs)  EES1) @ [x]  TrES1"
                    by (simp only: total_def)
                  moreover
                  have "((τ @ xs)  EES1)  (ρ1 𝒱1) = ((τ @ xs)  EES1)  (ρ1 𝒱1)" ..
                  ultimately show ?thesis
                    by (simp add: Adm_def, auto)
                qed
                moreover note BSIA1
                ultimately obtain t1'
                  where res1: "((τ @ xs)  EES1) @ [x] @ t1'  TrES1"
                  and res2: "t1'  V𝒱1 = t1''  V𝒱1"
                  and res3: "t1'  C𝒱1 = []"
                  by (simp only: BSIA_def, blast)

                have "set t1'  EES1"
                proof -
                  from res1 validES1 have "set (((τ @ xs)  EES1) @ [x] @ t1')  EES1"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  thus ?thesis
                    by auto
                qed
                moreover 
                have "((τ @ r2)  EES1) @ t1'  TrES1"
                proof -
                  from res1 xs_is_xsE1 have "((τ  EES1) @ (xs @ [x])) @ t1'  TrES1"
                    by (simp only: projection_concatenation_commute, auto)
                  thus  ?thesis
                    by (simp only: snoc(2) projection_concatenation_commute)
                qed
                moreover
                from t1''Vv1_is_t1Vv1 res2 have "t1'  V𝒱1 = t1  V𝒱1"
                  by auto
                moreover
                note res3
                ultimately show ?case
                  by auto
              qed
              from this[OF r2E1_in_Nv2_inter_C1_star] obtain t1'
                where t1'_in_E1star: "set t1'  EES1" 
                and τr2E1_t1'_in_Tr1: "((τ @ r2)  EES1) @ t1'  TrES1"
                and t1'_Vv1_is_t1_Vv1: "t1'  V𝒱1 = t1  V𝒱1"
                and t1'_Cv1_empty: "t1'  C𝒱1 = []"
                by auto
              
              let ?tau = "τ @ r2 @ [𝒱']"
              
              from v'_in_E2 Cons(2) r2_in_Nv2star validV2 have "set ?tau  E(ES1  ES2)"
                by (simp only: composeES_def isViewOn_def V_valid_def 
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
              moreover
              from Cons(3) have "set lambda'  V𝒱"
                by auto
              moreover
              from Cons(5) t2_is_r2_v'_s2 have "set s2  EES2"
                by auto
              moreover
              note t1'_in_E1star
              moreover
              have "?tau  EES2 @ s2  TrES2"              
                by (metis Cons_eq_appendI append_eq_appendI calculation(3) eq_Nil_appendI 
                  list_subset_iff_projection_neutral Cons.prems(4) Cons.prems(6) 
                  projection_concatenation_commute t2_is_r2_v'_s2)
              moreover
              from τr2E1_t1'_in_Tr1 v'_notin_E1 have "?tau  EES1 @ t1'  TrES1"
                by (simp add: projection_def)
              moreover
              from Cons(9) t2_is_r2_v'_s2 r2_Vv_empty v'_in_E2 v'_in_Vv 
              have "lambda'  EES2 = s2  V𝒱"
                by (simp add: projection_def)
              moreover
              from Cons(10) v'_notin_E1 t1'_Vv1_is_t1_Vv1 
              have "lambda'  EES1 = t1'  V𝒱"         
              proof -
                have "t1'  V𝒱 = t1'  V𝒱1" 
                  using propSepViews unfolding properSeparationOfViews_def  
                  by (simp add: projection_def, metis Int_commute 
                    projection_def projection_intersection_neutral t1'_in_E1star)
                moreover
                have "t1  V𝒱 = t1  V𝒱1" 
                  using propSepViews unfolding properSeparationOfViews_def           
                  by (simp add: projection_def, metis Int_commute  
                    projection_def projection_intersection_neutral Cons(4))
                moreover
                note Cons(8) v'_notin_E1 t1'_Vv1_is_t1_Vv1
                ultimately show ?thesis
                  by (simp add: projection_def)
              qed
              moreover
              note s2_Cv2_empty t1'_Cv1_empty
              moreover
              note Cons.hyps(1)[of ?tau t1' s2]
              ultimately obtain t'
                where τr2v't'_in_Tr: "?tau @ t'  Tr(ES1  ES2)"
                and t'_Vv_is_lambda': "t'  V𝒱 = lambda'"
                and t'_Cv_empty: "t'  C𝒱 = []"
                by auto

              let ?t = "r2 @ [𝒱'] @ t'"

              note τr2v't'_in_Tr
              moreover
              from r2_Vv_empty t'_Vv_is_lambda' v'_in_Vv have "?t  V𝒱 = 𝒱' # lambda'"
                by (simp add: projection_def)
              moreover
              have "?t  C𝒱 = []"
              proof -
                have "r2  C𝒱 = []"
                proof -
                  from propSepViews have "EES2  C𝒱  C𝒱2" 
                    unfolding properSeparationOfViews_def by auto
                  from projection_on_subset[OF ‹EES2  C𝒱  C𝒱2 r2_Cv2_empty] 
                  have "r2  (EES2  C𝒱) = []"
                    by (simp only: Int_commute)
                  with projection_intersection_neutral[OF r2_in_E2star, of "C𝒱"] show ?thesis
                    by simp
                qed
                with v'_in_Vv VIsViewOnE t'_Cv_empty show ?thesis
                  by (simp add: isViewOn_def V_valid_def
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def projection_def, auto)
              qed
              ultimately have ?thesis
                by auto
            }
            ultimately show ?thesis
              by blast
        qed
        
      qed 
  }
  thus ?thesis
    by auto
qed

(* The generalized zipping lemma (Lemma 6.4.4) *)
lemma generalized_zipping_lemma: 
 " τ lambda t1 t2. ( ( set τ  E(ES1  ES2)
   set lambda  V𝒱  set t1  EES1  set t2  EES2
   ((τ  EES1) @ t1)  TrES1  ((τ  EES2) @ t2)  TrES2
   (lambda  EES1) = (t1  V𝒱)  (lambda  EES2) = (t2  V𝒱)
   (t1  C𝒱1) = []  (t2  C𝒱2) = []) 
   (t. ((τ @ t)  Tr(ES1  ES2)  (t  V𝒱) = lambda  (t  C𝒱) = [])) )"
proof -
  note well_behaved_composition
  moreover {
    assume "N𝒱1  EES2 = {}  N𝒱2  EES1 = {}"
    with generalized_zipping_lemma1 have ?thesis
      by auto
  }
  moreover {
    assume " ρ1. N𝒱1  EES2 = {}  total ES1 (C𝒱1  N𝒱2)  BSIA ρ1 𝒱1 TrES1"
    then obtain ρ1 where "N𝒱1  EES2 = {}  total ES1 (C𝒱1  N𝒱2)  BSIA ρ1 𝒱1 TrES1"
        by auto
    with generalized_zipping_lemma2[of ρ1] have ?thesis
      by auto
  }
  moreover {
    assume " ρ2. N𝒱2  EES1 = {}  total ES2 (C𝒱2  N𝒱1)  BSIA ρ2 𝒱2 TrES2"
    then obtain ρ2 where "N𝒱2  EES1 = {}  total ES2 (C𝒱2  N𝒱1)  BSIA ρ2 𝒱2 TrES2"
      by auto
    with generalized_zipping_lemma3[of ρ2] have ?thesis
      by auto
  }
  moreover {
    assume " ρ1 ρ2 Γ1 Γ2. (Γ1  EES1  ΔΓ1  EES1  ΥΓ1  EES1
      Γ2  EES2  ΔΓ2  EES2  ΥΓ2  EES2
       BSIA ρ1 𝒱1 TrES1  BSIA ρ2 𝒱2 TrES2
       total ES1 (C𝒱1  N𝒱2)  total ES2 (C𝒱2  N𝒱1)
       FCIA ρ1 Γ1 𝒱1 TrES1  FCIA ρ2 Γ2 𝒱2 TrES2
       V𝒱1  V𝒱2 Γ1 Γ2
       C𝒱1  N𝒱2  ΥΓ1  C𝒱2  N𝒱1  ΥΓ2
       N𝒱1  ΔΓ1  EES2 = {}  N𝒱2  ΔΓ2  EES1 = {} )"
    then obtain ρ1 ρ2 Γ1 Γ2 where "∇Γ1  EES1  ΔΓ1  EES1  ΥΓ1  EES1
      Γ2  EES2  ΔΓ2  EES2  ΥΓ2  EES2
       BSIA ρ1 𝒱1 TrES1  BSIA ρ2 𝒱2 TrES2
       total ES1 (C𝒱1  N𝒱2)  total ES2 (C𝒱2  N𝒱1)
       FCIA ρ1 Γ1 𝒱1 TrES1  FCIA ρ2 Γ2 𝒱2 TrES2
       V𝒱1  V𝒱2 Γ1 Γ2
       C𝒱1  N𝒱2  ΥΓ1  C𝒱2  N𝒱1  ΥΓ2
       N𝒱1  ΔΓ1  EES2 = {}  N𝒱2  ΔΓ2  EES1 = {}"
      by auto
    with generalized_zipping_lemma4[of Γ1 Γ2 ρ1 ρ2]  have ?thesis
      by auto
  }
  ultimately show ?thesis unfolding wellBehavedComposition_def
    by blast
qed

end

end

Theory CompositionalityResults

theory CompositionalityResults
imports GeneralizedZippingLemma CompositionSupport
begin

context Compositionality 
begin


(* Theorem 6.4.1 case 1 *)
theorem compositionality_BSD: 
" BSD 𝒱1 TrES1; BSD 𝒱2 TrES2   BSD 𝒱 Tr(ES1  ES2)"
proof -
  assume BSD_Tr1_v1: "BSD 𝒱1 TrES1"
  assume BSD_Tr2_v2: "BSD 𝒱2 TrES2"
  {
    fix α β c
    assume c_in_Cv: "c  C𝒱"
    assume βcα_in_Tr: "(β @ [c] @ α)  Tr(ES1  ES2)"
    assume α_contains_no_c: "α  C𝒱 = []"

    interpret CSES1: CompositionSupport "ES1" "𝒱" "𝒱1"  
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES1 validV1)

    interpret CSES2: CompositionSupport "ES2" "𝒱" "𝒱2"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES2 validV2)

    from βcα_in_Tr 
    have  βcα_E1_in_Tr1: "((β @ [c] @ α)  EES1)  TrES1"
      and βcα_E2_in_Tr2: "((β @ [c] @ α)  EES2)  TrES2"
      by (auto, simp add: composeES_def)+

    from composeES_yields_ES validES1 validES2 have "ES_valid (ES1  ES2)"
      by auto

    with βcα_in_Tr have "set β  E(ES1  ES2)"
      by (simp add: ES_valid_def traces_contain_events_def, auto)
    moreover
    have "set (α  V𝒱)  V𝒱"
      by (simp add: projection_def, auto)
    moreover 
    have "(α  V𝒱)  V𝒱 = (α  V𝒱)"
      by (simp add: projection_def)
    moreover
    from CSES1.BSD_in_subsystem[OF c_in_Cv βcα_E1_in_Tr1 BSD_Tr1_v1]
    obtain α1' 
      where α1'_1: "((β  EES1) @ α1')  TrES1"
      and α1'_2: "(α1'  V𝒱1) = (α  V𝒱1)"
      and "α1'  C𝒱1 = []"
      by auto
    moreover
    from α1'_1 validES1 have α1'_in_E1: "set α1'  EES1"
      by (simp add: ES_valid_def traces_contain_events_def, auto)
    moreover
    from α1'_2 propSepViews have "((α  V𝒱)  EES1) = (α1'  V𝒱)"
      proof -
        have "((α  V𝒱)  EES1) = α  (V𝒱  EES1)"
          by (simp only: projection_def, auto)
        with propSepViews have "((α  V𝒱)  EES1) = (α  V𝒱1)"
          unfolding properSeparationOfViews_def by auto
        moreover
        from α1'_2 have "(α1'  V𝒱1) = (α1'  V𝒱)"
          proof -
            from α1'_in_E1 have "α1'  EES1 = α1'"
              by (simp add: list_subset_iff_projection_neutral)
            hence "(α1'  EES1)  V𝒱 = α1'  V𝒱"
              by simp
            with Vv_is_Vv1_union_Vv2 have "(α1'  EES1)  (V𝒱1  V𝒱2) = α1'  V𝒱"
              by simp
            hence "α1'  (EES1  (V𝒱1  V𝒱2)) = α1'  V𝒱"
              by (simp only: projection_def, auto)
            hence "α1'  (EES1  V𝒱1  EES1  V𝒱2) = α1'  V𝒱"
              by (simp add: Int_Un_distrib)
            moreover 
            from validV1 have "EES1  V𝒱1 = V𝒱1"
              by (simp add: isViewOn_def V_valid_def 
                VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
            ultimately have "α1'  (V𝒱1  EES1  V𝒱2) = α1'  V𝒱"
              by simp
            moreover
            have "EES1  V𝒱2  V𝒱1" 
              proof -
                from propSepViews Vv_is_Vv1_union_Vv2 have "(V𝒱1  V𝒱2)  EES1 = V𝒱1"
                  unfolding properSeparationOfViews_def by simp
                hence "(V𝒱1  EES1  V𝒱2  EES1) = V𝒱1"
                  by auto
                with validV1 have "(V𝒱1  V𝒱2  EES1) = V𝒱1"
                  by (simp add: isViewOn_def V_valid_def  
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                thus ?thesis
                  by auto
              qed
            ultimately show ?thesis
               by (simp add: Un_absorb2)
          qed
          moreover note α1'_2
          ultimately show ?thesis
            by auto
      qed 
    moreover
    from CSES2.BSD_in_subsystem[OF c_in_Cv βcα_E2_in_Tr2 BSD_Tr2_v2]
    obtain α2' 
      where α2'_1: "((β  EES2) @ α2')  TrES2"
      and α2'_2: "(α2'  V𝒱2) = (α  V𝒱2)"
      and "α2'  C𝒱2 = []"
      by auto
     moreover
    from α2'_1 validES2 have α2'_in_E2: "set α2'  EES2"
      by (simp add: ES_valid_def traces_contain_events_def, auto)
    moreover
    from α2'_2 propSepViews have "((α  V𝒱)  EES2) = (α2'  V𝒱)"
      proof -
        have "((α  V𝒱)  EES2) = α  (V𝒱  EES2)"
          by (simp only: projection_def, auto)
        with propSepViews have "((α  V𝒱)  EES2) = (α  V𝒱2)"
          unfolding properSeparationOfViews_def by auto
        moreover
        from α2'_2 have "(α2'  V𝒱2) = (α2'  V𝒱)"
          proof -
            from α2'_in_E2 have "α2'  EES2 = α2'"
              by (simp add: list_subset_iff_projection_neutral)
            hence "(α2'  EES2)  V𝒱 = α2'  V𝒱"
              by simp
            with Vv_is_Vv1_union_Vv2 have "(α2'  EES2)  (V𝒱2  V𝒱1) = α2'  V𝒱"
              by (simp add: Un_commute)
            hence "α2'  (EES2  (V𝒱2  V𝒱1)) = α2'  V𝒱"
              by (simp only: projection_def, auto)
            hence "α2'  (EES2  V𝒱2  EES2  V𝒱1) = α2'  V𝒱"
              by (simp add: Int_Un_distrib)
            moreover 
            from validV2 have "EES2  V𝒱2 = V𝒱2"
              by (simp add: isViewOn_def V_valid_def 
                VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
            ultimately have "α2'  (V𝒱2  EES2  V𝒱1) = α2'  V𝒱"
              by simp
            moreover
            have "EES2  V𝒱1  V𝒱2" 
              proof -
                from propSepViews Vv_is_Vv1_union_Vv2 have "(V𝒱2  V𝒱1)  EES2 = V𝒱2"
                  unfolding properSeparationOfViews_def by (simp add: Un_commute)
                hence "(V𝒱2  EES2  V𝒱1  EES2) = V𝒱2"
                  by auto
                with validV2 have "(V𝒱2  V𝒱1  EES2) = V𝒱2"
                  by (simp add: isViewOn_def V_valid_def 
                    VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                thus ?thesis
                  by auto
              qed
            ultimately show ?thesis
               by (simp add: Un_absorb2)
          qed
          moreover note α2'_2
          ultimately show ?thesis
            by auto
      qed
    moreover note generalized_zipping_lemma
    ultimately have "α'. ((β @ α')  (Tr(ES1  ES2))  (α'  V𝒱 = (α  V𝒱))  α'  C𝒱 = [])"
      by blast
  }
  thus ?thesis 
    unfolding BSD_def
    by auto
qed

(* Theorem 6.4.1 case 2 *)
theorem compositionality_BSI: 
" BSD 𝒱1 TrES1; BSD 𝒱2 TrES2; BSI 𝒱1 TrES1; BSI 𝒱2 TrES2 
     BSI 𝒱 Tr(ES1  ES2)"
proof -
  assume BSD1: "BSD 𝒱1 TrES1"
     and BSD2: "BSD 𝒱2 TrES2"
     and BSI1: "BSI 𝒱1 TrES1"
     and BSI2: "BSI 𝒱2 TrES2"

  {
    fix α β c
    assume c_in_Cv: "c  C𝒱"
    assume βα_in_Tr: "(β @ α)  Tr(ES1  ES2)"
    assume α_no_Cv: "α  C𝒱 = []"
    
    from βα_in_Tr 
    have  βα_E1_in_Tr1: "((β @ α)  EES1)  TrES1"
      and βα_E2_in_Tr2: "((β @ α)  EES2)  TrES2"
      by (simp add: composeES_def)+

    interpret CSES1: CompositionSupport "ES1" "𝒱" "𝒱1"
      using propSepViews unfolding properSeparationOfViews_def
      by (simp add: CompositionSupport_def validES1 validV1)

    interpret CSES2: CompositionSupport "ES2" "𝒱" "𝒱2"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES2 validV2)

    from CSES1.BSD_in_subsystem2[OF βα_E1_in_Tr1 BSD1] obtain α1'
      where βE1α1'_in_Tr1: "β  EES1 @ α1'  TrES1"
      and α1'Vv1_is_αVv1: "α1'  V𝒱1 = α  V𝒱1"
      and α1'Cv1_empty: "α1'  C𝒱1 = []"
      by auto

    from CSES2.BSD_in_subsystem2[OF βα_E2_in_Tr2 BSD2] obtain α2'
      where βE2α2'_in_Tr2: "β  EES2 @ α2'  TrES2"
      and α2'Vv2_is_αVv2: "α2'  V𝒱2 = α  V𝒱2"
      and α2'Cv2_empty: "α2'  C𝒱2 = []"
      by auto
  
    have " α1''. (set α1''  EES1  ((β @ [c])  EES1) @ α1''  TrES1 
       α1''  V𝒱1 = α  V𝒱1  α1''  C𝒱1 = [])"
      proof cases
        assume cE1_empty: "[c]  EES1 = []"
        
        from βE1α1'_in_Tr1 validES1 have "set α1'  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        from cE1_empty βE1α1'_in_Tr1 have "((β @ [c])  EES1) @ α1'  TrES1"
          by (simp only: projection_concatenation_commute, auto)
        moreover
        note α1'Vv1_is_αVv1 α1'Cv1_empty
        ultimately show ?thesis
          by auto
      next
        assume cE1_not_empty: "[c]  EES1  []"
        hence c_in_E1: "c  EES1"
          by (simp only: projection_def, auto, split if_split_asm, auto)

        from c_in_Cv c_in_E1 propSepViews have "c  C𝒱1"
          unfolding properSeparationOfViews_def by auto
        moreover
        note βE1α1'_in_Tr1 α1'Cv1_empty BSI1
        ultimately obtain α1'' 
          where βE1cα1''_in_Tr1: "(β  EES1) @ [c] @ α1''  TrES1"
          and   α1''Vv1_is_α1'Vv1: "α1''  V𝒱1 = α1'  V𝒱1"
          and   α1''Cv1_empty: "α1''  C𝒱1 = []"
          unfolding BSI_def
          by blast
        
        from validES1 βE1cα1''_in_Tr1 have "set α1''  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        from βE1cα1''_in_Tr1 c_in_E1 have "((β @ [c])  EES1) @ α1''  TrES1"
          by (simp only: projection_concatenation_commute projection_def, auto)
        moreover
        from α1''Vv1_is_α1'Vv1 α1'Vv1_is_αVv1 have "α1''  V𝒱1 = α  V𝒱1"
          by auto
        moreover
        note α1''Cv1_empty
        ultimately show ?thesis
          by auto
      qed
    then obtain α1''
      where α1''_in_E1star: "set α1''  EES1" 
      and βcE1α1''_in_Tr1: "((β @ [c])  EES1) @ α1''  TrES1" 
      and α1''Vv1_is_αVv1: "α1''  V𝒱1 = α  V𝒱1"
      and α1''Cv1_empty: "α1''  C𝒱1 = []"
      by auto

    have " α2''. (set α2''  EES2 
       ((β @ [c])  EES2) @ α2''  TrES2 
       α2''  V𝒱2 = α  V𝒱2 
       α2''  C𝒱2 = [])"
      proof cases
        assume cE2_empty: "[c]  EES2 = []"
        
        from βE2α2'_in_Tr2 validES2 have "set α2'  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        from cE2_empty βE2α2'_in_Tr2 have "((β @ [c])  EES2) @ α2'  TrES2"
          by (simp only: projection_concatenation_commute, auto)
        moreover
        note α2'Vv2_is_αVv2 α2'Cv2_empty
        ultimately show ?thesis
          by auto
      next
        assume cE2_not_empty: "[c]  EES2  []"
        hence c_in_E2: "c  EES2"
          by (simp only: projection_def, auto, split if_split_asm, auto)

        from c_in_Cv c_in_E2 propSepViews have "c  C𝒱2"
          unfolding properSeparationOfViews_def by auto
        moreover
        note βE2α2'_in_Tr2 α2'Cv2_empty BSI2
        ultimately obtain α2'' 
          where βE2cα2''_in_Tr2: "(β  EES2) @ [c] @ α2''  TrES2"
          and   α2''Vv2_is_α2'Vv2: "α2''  V𝒱2 = α2'  V𝒱2"
          and   α2''Cv2_empty: "α2''  C𝒱2 = []"
          unfolding BSI_def
          by blast
        
        from validES2 βE2cα2''_in_Tr2 have "set α2''  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        from βE2cα2''_in_Tr2 c_in_E2 have "((β @ [c])  EES2) @ α2''  TrES2"
          by (simp only: projection_concatenation_commute projection_def, auto)
        moreover
        from α2''Vv2_is_α2'Vv2 α2'Vv2_is_αVv2 have "α2''  V𝒱2 = α  V𝒱2"
          by auto
        moreover
        note α2''Cv2_empty
        ultimately show ?thesis
          by auto
      qed
    then obtain α2''
      where α2''_in_E2star: "set α2''  EES2" 
      and βcE2α2''_in_Tr2: "((β @ [c])  EES2) @ α2''  TrES2" 
      and α2''Vv2_is_αVv2: "α2''  V𝒱2 = α  V𝒱2"
      and α2''Cv2_empty: "α2''  C𝒱2 = []"
      by auto 
    
    (* apply the generalized zipping lemma *)
    from VIsViewOnE c_in_Cv βα_in_Tr have "set (β @ [c])  E(ES1  ES2)"
      by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
        VN_disjoint_def NC_disjoint_def composeES_def, auto)
    moreover
    have "set (α  V𝒱)  V𝒱"
      by (simp add: projection_def, auto)
    moreover
    note α1''_in_E1star α2''_in_E2star βcE1α1''_in_Tr1 βcE2α2''_in_Tr2
    moreover
    have "(α  V𝒱)  EES1 = α1''  V𝒱"
      proof -
        from  α1''Vv1_is_αVv1 propSepViews have "α  (V𝒱  EES1) = α1''  (EES1  V𝒱)"
          unfolding properSeparationOfViews_def by (simp add: Int_commute)
        hence "α  V𝒱  EES1 = α1''  EES1  V𝒱"
          by (simp add: projection_def)
        with α1''_in_E1star show ?thesis
          by (simp add: list_subset_iff_projection_neutral)
      qed
    moreover
    have "(α  V𝒱)  EES2 = α2''  V𝒱"
      proof -
        from  α2''Vv2_is_αVv2 propSepViews have "α  (V𝒱  EES2) = α2''  (EES2  V𝒱)"
          unfolding properSeparationOfViews_def  by (simp add: Int_commute)
        hence "α  V𝒱  EES2 = α2''  EES2  V𝒱"
          by (simp add: projection_def)
        with α2''_in_E2star show ?thesis
          by (simp add: list_subset_iff_projection_neutral)
      qed
    moreover
    note α1''Cv1_empty α2''Cv2_empty generalized_zipping_lemma
    ultimately have "α'. (β @ [c]) @ α'  Tr(ES1  ES2)  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []"
      by blast
  }
  thus ?thesis
    unfolding BSI_def
    by auto
qed

(* Theorem 6.4.1 case 3 *)
theorem compositionality_BSIA: 
" BSD 𝒱1 TrES1; BSD 𝒱2 TrES2; BSIA ρ1 𝒱1 TrES1; BSIA ρ2 𝒱2 TrES2; 
  (ρ1 𝒱1)  (ρ 𝒱)  EES1; (ρ2 𝒱2)  (ρ 𝒱)  EES2  
     BSIA ρ 𝒱 (Tr(ES1  ES2))"
proof -
  assume BSD1: "BSD 𝒱1 TrES1"
  and BSD2: "BSD 𝒱2 TrES2"
  and BSIA1: "BSIA ρ1 𝒱1 TrES1"
  and BSIA2: "BSIA ρ2 𝒱2 TrES2"
  and ρ1v1_subset_ρv_inter_E1: "(ρ1 𝒱1)  (ρ 𝒱)  EES1"
  and ρ2v2_subset_ρv_inter_E2:"(ρ2 𝒱2)  (ρ 𝒱)  EES2"

  {
    fix α β c
    assume c_in_Cv: "c  C𝒱"
    assume βα_in_Tr: "(β @ α)  Tr(ES1  ES2)"
    assume α_no_Cv: "α  C𝒱 = []"
    assume Adm: "(Adm 𝒱 ρ Tr(ES1  ES2) β c)"
    then obtain γ
      where γρv_is_βρv: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
      and γc_in_Tr: "(γ @ [c])  Tr(ES1  ES2)"
      unfolding Adm_def
      by auto

    from βα_in_Tr 
    have  βα_E1_in_Tr1: "((β @ α)  EES1)  TrES1"
      and βα_E2_in_Tr2: "((β @ α)  EES2)  TrES2"
      by (simp add: composeES_def)+

    interpret CSES1: CompositionSupport "ES1" "𝒱" "𝒱1"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES1 validV1)

    interpret CSES2: CompositionSupport "ES2" "𝒱" "𝒱2"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES2 validV2)


    from CSES1.BSD_in_subsystem2[OF βα_E1_in_Tr1 BSD1] obtain α1'
      where βE1α1'_in_Tr1: "β  EES1 @ α1'  TrES1"
      and α1'Vv1_is_αVv1: "α1'  V𝒱1 = α  V𝒱1"
      and α1'Cv1_empty: "α1'  C𝒱1 = []"
      by auto

    from CSES2.BSD_in_subsystem2[OF βα_E2_in_Tr2 BSD2] obtain α2'
      where βE2α2'_in_Tr2: "β  EES2 @ α2'  TrES2"
      and α2'Vv2_is_αVv2: "α2'  V𝒱2 = α  V𝒱2"
      and α2'Cv2_empty: "α2'  C𝒱2 = []"
      by auto

    have " α1''. (set α1''  EES1 
       ((β @ [c])  EES1) @ α1''  TrES1 
       α1''  V𝒱1 = α  V𝒱1 
       α1''  C𝒱1 = [])"
      proof cases
        assume cE1_empty: "[c]  EES1 = []"
        
        from βE1α1'_in_Tr1 validES1 have "set α1'  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        from cE1_empty βE1α1'_in_Tr1 have "((β @ [c])  EES1) @ α1'  TrES1"
          by (simp only: projection_concatenation_commute, auto)
        moreover
        note α1'Vv1_is_αVv1 α1'Cv1_empty
        ultimately show ?thesis
          by auto
      next
        assume cE1_not_empty: "[c]  EES1  []"
        hence c_in_E1: "c  EES1"
          by (simp only: projection_def, auto, split if_split_asm, auto)

        from c_in_Cv c_in_E1 propSepViews have "c  C𝒱1"
          unfolding properSeparationOfViews_def by auto
        moreover
        note βE1α1'_in_Tr1 α1'Cv1_empty
        moreover
        have "(Adm 𝒱1 ρ1 TrES1 (β  EES1) c)" 
          proof -
            from c_in_E1 γc_in_Tr have "(γ  EES1) @ [c]  TrES1"
              by (simp add: projection_def composeES_def)
            moreover
            have "γ  EES1  (ρ1 𝒱1) = β  EES1  (ρ1 𝒱1)"
              proof -
                from γρv_is_βρv have "γ  EES1  (ρ 𝒱) = β  EES1  (ρ 𝒱)"
                  by (metis projection_commute)
                with ρ1v1_subset_ρv_inter_E1 have "γ  (ρ1 𝒱1) = β  (ρ1 𝒱1)"
                  by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
                thus ?thesis
                  by (metis projection_commute)
              qed
           ultimately show ?thesis unfolding Adm_def
              by auto
          qed
        moreover
        note BSIA1
        ultimately obtain α1'' 
          where βE1cα1''_in_Tr1: "(β  EES1) @ [c] @ α1''  TrES1"
          and   α1''Vv1_is_α1'Vv1: "α1''  V𝒱1 = α1'  V𝒱1"
          and   α1''Cv1_empty: "α1''  C𝒱1 = []"
          unfolding BSIA_def
          by blast
        
        from validES1 βE1cα1''_in_Tr1 have "set α1''  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        from βE1cα1''_in_Tr1 c_in_E1 have "((β @ [c])  EES1) @ α1''  TrES1"
          by (simp only: projection_concatenation_commute projection_def, auto)
        moreover
        from α1''Vv1_is_α1'Vv1 α1'Vv1_is_αVv1 have "α1''  V𝒱1 = α  V𝒱1"
          by auto
        moreover
        note α1''Cv1_empty
        ultimately show ?thesis
          by auto
      qed
    then obtain α1''
      where α1''_in_E1star: "set α1''  EES1" 
      and βcE1α1''_in_Tr1: "((β @ [c])  EES1) @ α1''  TrES1" 
      and α1''Vv1_is_αVv1: "α1''  V𝒱1 = α  V𝒱1"
      and α1''Cv1_empty: "α1''  C𝒱1 = []"
      by auto

    have " α2''. (set α2''  EES2 
       ((β @ [c])  EES2) @ α2''  TrES2 
       α2''  V𝒱2 = α  V𝒱2 
       α2''  C𝒱2 = [])"
      proof cases
        assume cE2_empty: "[c]  EES2 = []"
        
        from βE2α2'_in_Tr2 validES2 have "set α2'  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        from cE2_empty βE2α2'_in_Tr2 have "((β @ [c])  EES2) @ α2'  TrES2"
          by (simp only: projection_concatenation_commute, auto)
        moreover
        note α2'Vv2_is_αVv2 α2'Cv2_empty
        ultimately show ?thesis
          by auto
      next
        assume cE2_not_empty: "[c]  EES2  []"
        hence c_in_E2: "c  EES2"
          by (simp only: projection_def, auto, split if_split_asm, auto)

        from c_in_Cv c_in_E2 propSepViews have "c  C𝒱2"
          unfolding properSeparationOfViews_def by auto
        moreover
        note βE2α2'_in_Tr2 α2'Cv2_empty
        moreover
        have "(Adm 𝒱2 ρ2 TrES2 (β  EES2) c)" 
          proof -
            from c_in_E2 γc_in_Tr have "(γ  EES2) @ [c]  TrES2"
              by (simp add: projection_def composeES_def)
            moreover
            have "γ  EES2  (ρ2 𝒱2) = β  EES2  (ρ2 𝒱2)"
              proof -
                from γρv_is_βρv have "γ  EES2  (ρ 𝒱) = β  EES2  (ρ 𝒱)"
                  by (metis projection_commute)
                with ρ2v2_subset_ρv_inter_E2 have "γ  (ρ2 𝒱2) = β  (ρ2 𝒱2)"
                  by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
                thus ?thesis
                  by (metis projection_commute)
              qed
           ultimately show ?thesis unfolding Adm_def
              by auto
          qed
        moreover
        note BSIA2
        ultimately obtain α2'' 
          where βE2cα2''_in_Tr2: "(β  EES2) @ [c] @ α2''  TrES2"
          and   α2''Vv2_is_α2'Vv2: "α2''  V𝒱2 = α2'  V𝒱2"
          and   α2''Cv2_empty: "α2''  C𝒱2 = []"
          unfolding BSIA_def
          by blast
        
        from validES2 βE2cα2''_in_Tr2 have "set α2''  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        from βE2cα2''_in_Tr2 c_in_E2 have "((β @ [c])  EES2) @ α2''  TrES2"
          by (simp only: projection_concatenation_commute projection_def, auto)
        moreover
        from α2''Vv2_is_α2'Vv2 α2'Vv2_is_αVv2 have "α2''  V𝒱2 = α  V𝒱2"
          by auto
        moreover
        note α2''Cv2_empty
        ultimately show ?thesis
          by auto
      qed
    then obtain α2''
      where α2''_in_E2star: "set α2''  EES2" 
      and βcE2α2''_in_Tr2: "((β @ [c])  EES2) @ α2''  TrES2" 
      and α2''Vv2_is_αVv2: "α2''  V𝒱2 = α  V𝒱2"
      and α2''Cv2_empty: "α2''  C𝒱2 = []"
      by auto
    
    (* apply the generalized zipping lemma *)
    from VIsViewOnE c_in_Cv βα_in_Tr have "set (β @ [c])  E(ES1  ES2)"
      by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
        VN_disjoint_def NC_disjoint_def composeES_def, auto)
    moreover
    have "set (α  V𝒱)  V𝒱"
      by (simp add: projection_def, auto)
    moreover
    note α1''_in_E1star α2''_in_E2star βcE1α1''_in_Tr1 βcE2α2''_in_Tr2
    moreover
    have "(α  V𝒱)  EES1 = α1''  V𝒱"
      proof -
        from  α1''Vv1_is_αVv1 propSepViews 
        have "α  (V𝒱  EES1) = α1''  (EES1  V𝒱)"
         unfolding properSeparationOfViews_def by (simp add: Int_commute)
        hence "α  V𝒱  EES1 = α1''  EES1  V𝒱"
          by (simp add: projection_def)
        with α1''_in_E1star show ?thesis
          by (simp add: list_subset_iff_projection_neutral)
      qed
    moreover
    have "(α  V𝒱)  EES2 = α2''  V𝒱"
      proof -
        from  α2''Vv2_is_αVv2 propSepViews 
        have "α  (V𝒱  EES2) = α2''  (EES2  V𝒱)"
          unfolding properSeparationOfViews_def by (simp add: Int_commute)
        hence "α  V𝒱  EES2 = α2''  EES2  V𝒱"
          by (simp add: projection_def)
        with α2''_in_E2star show ?thesis
          by (simp add: list_subset_iff_projection_neutral)
      qed
    moreover
    note α1''Cv1_empty α2''Cv2_empty generalized_zipping_lemma
    ultimately have "α'. (β @ [c]) @ α'  Tr(ES1  ES2)  α'  V𝒱 = α  V𝒱  α'  C𝒱 = []"
      by blast
  }
  thus ?thesis
    unfolding BSIA_def
    by auto
qed

(* Theorem 6.4.1 case 4 *)
theorem compositionality_FCD: 
 " BSD 𝒱1 TrES1; BSD 𝒱2 TrES2;Γ  EES1 Γ1;Γ  EES2 Γ2;
  ΥΓ  EES1  ΥΓ1; ΥΓ  EES2  ΥΓ2;
  ( ΔΓ1  N𝒱1  ΔΓ2  N𝒱2 )  ΔΓ;
  N𝒱1  ΔΓ1  EES2 = {}; N𝒱2  ΔΓ2  EES1 = {};
  FCD Γ1 𝒱1 TrES1; FCD Γ2 𝒱2 TrES2  
   FCD Γ 𝒱 (Tr(ES1  ES2))"
proof -
  assume BSD1: "BSD 𝒱1 TrES1"
    and BSD2: "BSD 𝒱2 TrES2"
    and Nabla_inter_E1_subset_Nabla1: "∇Γ  EES1 Γ1"
    and Nabla_inter_E2_subset_Nabla2: "∇Γ  EES2 Γ2"
    and Upsilon_inter_E1_subset_Upsilon1: Γ  EES1  ΥΓ1"
    and Upsilon_inter_E2_subset_Upsilon2: Γ  EES2  ΥΓ2"
    and Delta1_N1_Delta2_N2_subset_Delta: "( ΔΓ1  N𝒱1  ΔΓ2  N𝒱2 )  ΔΓ"
    and N1_Delta1_E2_disjoint: "N𝒱1  ΔΓ1  EES2 = {}"
    and N2_Delta2_E1_disjoint: "N𝒱2  ΔΓ2  EES1 = {}"
    and FCD1: "FCD Γ1 𝒱1 TrES1"
    and FCD2: "FCD Γ2 𝒱2 TrES2"

  {
    fix α β c v'
    assume c_in_Cv_inter_Upsilon: "c  (C𝒱  ΥΓ)"
      and v'_in_Vv_inter_Nabla: "v'  (V𝒱 Γ)"
      and βcv'α_in_Tr: "(β @ [c,v'] @ α)  Tr(ES1  ES2)" 
      and αCv_empty: "α  C𝒱 = []"

    from  βcv'α_in_Tr
    have  βcv'α_E1_in_Tr1: "(((β @ [c,v']) @ α)  EES1)  TrES1"
      and βcv'α_E2_in_Tr2: "(((β @ [c,v']) @ α)  EES2)  TrES2"
      by (simp add: composeES_def)+

    interpret CSES1: CompositionSupport "ES1" "𝒱" "𝒱1"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES1 validV1)

    interpret CSES2: CompositionSupport "ES2" "𝒱" "𝒱2"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES2 validV2)

    from CSES1.BSD_in_subsystem2[OF βcv'α_E1_in_Tr1 BSD1] obtain α1'
      where βcv'E1α1'_in_Tr1: "(β @ [c,v'])  EES1 @ α1'  TrES1"
      and α1'Vv1_is_αVv1: "α1'  V𝒱1 = α  V𝒱1"
      and α1'Cv1_empty: "α1'  C𝒱1 = []"
      by auto

    from CSES2.BSD_in_subsystem2[OF βcv'α_E2_in_Tr2 BSD2] obtain α2'
      where βcv'E2α2'_in_Tr2: "(β @ [c,v'])  EES2 @ α2'  TrES2"
      and α2'Vv2_is_αVv2: "α2'  V𝒱2 = α  V𝒱2"
      and α2'Cv2_empty: "α2'  C𝒱2 = []"
      by auto

    from c_in_Cv_inter_Upsilon v'_in_Vv_inter_Nabla validV1
    have "c  EES1  (c  EES1  v'  EES1)  (c  EES1  v'  EES1)"
      by (simp add: isViewOn_def V_valid_def
        VC_disjoint_def VN_disjoint_def NC_disjoint_def)
    moreover {
      assume c_notin_E1: "c  EES1"
     
      have "set []  (N𝒱1  ΔΓ1)"
        by auto
      moreover
      from βcv'E1α1'_in_Tr1 c_notin_E1 have "(β  EES1) @ [] @ ([v']  EES1) @ α1'  TrES1"
        by (simp only: projection_concatenation_commute projection_def, auto)
      moreover
      have "α1'  V𝒱1 = α1'  V𝒱1" ..
      moreover
      note α1'Cv1_empty 
      ultimately have " α1'' δ1''. set δ1''  (N𝒱1  ΔΓ1) 
         (β  EES1) @ δ1'' @ ([v']  EES1) @ α1''  TrES1        
         α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []"
        by blast
    }
    moreover {
      assume c_in_E1: "c  EES1"
      and v'_notin_E1: "v'  EES1"

      from c_in_E1 c_in_Cv_inter_Upsilon propSepViews
        Upsilon_inter_E1_subset_Upsilon1 
      have c_in_Cv1_Upsilon1: "c  (C𝒱1  ΥΓ1)"
        unfolding properSeparationOfViews_def by auto
      hence c_in_Cv1: "c  C𝒱1"
        by auto
      moreover
      from βcv'E1α1'_in_Tr1 c_in_E1 v'_notin_E1 have "(β  EES1) @ [c] @ α1'  TrES1"
        by (simp only: projection_concatenation_commute projection_def, auto)
      moreover
      note α1'Cv1_empty BSD1
      ultimately obtain α1''
        where first: "(β  EES1) @ α1''  TrES1"
        and second: "α1''  V𝒱1 = α1'  V𝒱1"
        and third: "α1''  C𝒱1 = []"
        unfolding BSD_def
        by blast
       
      have "set []  (N𝒱1  ΔΓ1)"
        by auto
      moreover
      from first v'_notin_E1 have "(β  EES1) @ [] @ ([v']  EES1) @ α1''  TrES1"
        by (simp add: projection_def)
      moreover
      note second third
      ultimately
      have " α1'' δ1''. set δ1''  (N𝒱1  ΔΓ1) 
         (β  EES1) @ δ1'' @ ([v']  EES1) @ α1''  TrES1        
         α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []"
        by blast
    }
    moreover {
      assume c_in_E1: "c  EES1"
      and v'_in_E1: "v'  EES1"
      
      from c_in_E1 c_in_Cv_inter_Upsilon propSepViews
        Upsilon_inter_E1_subset_Upsilon1 
      have c_in_Cv1_Upsilon1: "c  (C𝒱1  ΥΓ1)"
        unfolding properSeparationOfViews_def by auto
      moreover
      from v'_in_E1 v'_in_Vv_inter_Nabla propSepViews Nabla_inter_E1_subset_Nabla1
      have v'_in_Vv1_inter_Nabla1: "v'  (V𝒱1 Γ1)"
        unfolding properSeparationOfViews_def by auto
      moreover
      from βcv'E1α1'_in_Tr1 c_in_E1 v'_in_E1 have "(β  EES1) @ [c,v'] @ α1'  TrES1"
        by (simp add: projection_def)
      moreover
      note α1'Cv1_empty FCD1
      ultimately obtain α1'' δ1'' 
        where first: "set δ1''  (N𝒱1  ΔΓ1)"
        and second: "(β  EES1) @ δ1'' @ [v'] @ α1''  TrES1"
        and third: "α1''  V𝒱1 = α1'  V𝒱1"
        and fourth: "α1''  C𝒱1 = []"
        unfolding FCD_def
        by blast

      from second v'_in_E1 have "(β  EES1) @ δ1'' @ ([v']  EES1) @ α1''  TrES1"
        by (simp add: projection_def)
      with first third fourth
      have " α1'' δ1''. set δ1''  (N𝒱1  ΔΓ1) 
         (β  EES1) @ δ1'' @ ([v']  EES1) @ α1''  TrES1        
         α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []"
        unfolding FCD_def
        by blast
    }
    ultimately obtain α1'' δ1'' 
      where δ1''_in_Nv1_Delta1_star: "set δ1''  (N𝒱1  ΔΓ1)"
      and βE1δ1''vE1α1''_in_Tr1: "(β  EES1) @ δ1'' @ ([v']  EES1) @ α1''  TrES1"
      and α1''Vv1_is_α1'Vv1: "α1''  V𝒱1 = α1'  V𝒱1"
      and α1''Cv1_empty: "α1''  C𝒱1 = []"
      by blast
    with validV1 have δ1''_in_E1_star: "set δ1''  EES1"
      by (simp add: isViewOn_def V_valid_def 
        VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)

    from c_in_Cv_inter_Upsilon v'_in_Vv_inter_Nabla validV2
    have "c  EES2  (c  EES2  v'  EES2)  (c  EES2  v'  EES2)"
      by (simp add: isViewOn_def V_valid_def 
        VC_disjoint_def VN_disjoint_def NC_disjoint_def)
    moreover {
      assume c_notin_E2: "c  EES2"
     
      have "set []  (N𝒱2  ΔΓ2)"
        by auto
      moreover
      from βcv'E2α2'_in_Tr2 c_notin_E2 have "(β  EES2) @ [] @ ([v']  EES2) @ α2'  TrES2"
        by (simp only: projection_concatenation_commute projection_def, auto)
      moreover
      have "α2'  V𝒱2 = α2'  V𝒱2" ..
      moreover
      note α2'Cv2_empty 
      ultimately have " α2'' δ2''. set δ2''  (N𝒱2  ΔΓ2) 
         (β  EES2) @ δ2'' @ ([v']  EES2) @ α2''  TrES2        
         α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []"
        by blast
    }
    moreover {
      assume c_in_E2: "c  EES2"
      and v'_notin_E2: "v'  EES2"

      from c_in_E2 c_in_Cv_inter_Upsilon propSepViews Upsilon_inter_E2_subset_Upsilon2 
      have c_in_Cv2_Upsilon2: "c  (C𝒱2  ΥΓ2)"
        unfolding properSeparationOfViews_def by auto
      hence c_in_Cv2: "c  C𝒱2"
        by auto
      moreover
      from βcv'E2α2'_in_Tr2 c_in_E2 v'_notin_E2 have "(β  EES2) @ [c] @ α2'  TrES2"
        by (simp only: projection_concatenation_commute projection_def, auto)
      moreover
      note α2'Cv2_empty BSD2
      ultimately obtain α2''
        where first: "(β  EES2) @ α2''  TrES2"
        and second: "α2''  V𝒱2 = α2'  V𝒱2"
        and third: "α2''  C𝒱2 = []"
        unfolding BSD_def
        by blast
       
      have "set []  (N𝒱2  ΔΓ2)"
        by auto
      moreover
      from first v'_notin_E2 have "(β  EES2) @ [] @ ([v']  EES2) @ α2''  TrES2"
        by (simp add: projection_def)
      moreover
      note second third
      ultimately
      have " α2'' δ2''. set δ2''  (N𝒱2  ΔΓ2) 
         (β  EES2) @ δ2'' @ ([v']  EES2) @ α2''  TrES2        
         α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []"
        by blast
    }
    moreover {
      assume c_in_E2: "c  EES2"
      and v'_in_E2: "v'  EES2"
      
      from c_in_E2 c_in_Cv_inter_Upsilon propSepViews
        Upsilon_inter_E2_subset_Upsilon2 
      have c_in_Cv2_Upsilon2: "c  (C𝒱2  ΥΓ2)"
        unfolding properSeparationOfViews_def by auto
      moreover
      from v'_in_E2 v'_in_Vv_inter_Nabla propSepViews Nabla_inter_E2_subset_Nabla2
      have v'_in_Vv2_inter_Nabla2: "v'  (V𝒱2 Γ2)"
        unfolding properSeparationOfViews_def by auto
      moreover
      from βcv'E2α2'_in_Tr2 c_in_E2 v'_in_E2 have "(β  EES2) @ [c,v'] @ α2'  TrES2"
        by (simp add: projection_def)
      moreover
      note α2'Cv2_empty FCD2
      ultimately obtain α2'' δ2'' 
        where first: "set δ2''  (N𝒱2  ΔΓ2)"
        and second: "(β  EES2) @ δ2'' @ [v'] @ α2''  TrES2"
        and third: "α2''  V𝒱2 = α2'  V𝒱2"
        and fourth: "α2''  C𝒱2 = []"
        unfolding FCD_def
        by blast

      from second v'_in_E2 have "(β  EES2) @ δ2'' @ ([v']  EES2) @ α2''  TrES2"
        by (simp add: projection_def)
      with first third fourth
      have " α2'' δ2''. set δ2''  (N𝒱2  ΔΓ2) 
         (β  EES2) @ δ2'' @ ([v']  EES2) @ α2''  TrES2        
         α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []"
        unfolding FCD_def
        by blast
    }
    ultimately obtain α2'' δ2'' 
      where δ2''_in_Nv2_Delta2_star: "set δ2''  (N𝒱2  ΔΓ2)"
      and βE2δ2''vE2α2''_in_Tr2: "(β  EES2) @ δ2'' @ ([v']  EES2) @ α2''  TrES2"
      and α2''Vv2_is_α2'Vv2: "α2''  V𝒱2 = α2'  V𝒱2"
      and α2''Cv2_empty: "α2''  C𝒱2 = []"
      by blast
    with validV2 have δ2''_in_E2_star: "set δ2''  EES2"
      by (simp add: isViewOn_def V_valid_def  
        VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
    
    from δ1''_in_Nv1_Delta1_star N1_Delta1_E2_disjoint 
    have δ1''E2_empty: "δ1''  EES2 = []"
      proof -
        from δ1''_in_Nv1_Delta1_star have "δ1'' = δ1''  (N𝒱1  ΔΓ1)"
          by (simp only: list_subset_iff_projection_neutral)
        hence "δ1''  EES2 = δ1''  (N𝒱1  ΔΓ1)  EES2"
          by simp
        moreover
        have "δ1''  (N𝒱1  ΔΓ1)  EES2 = δ1''  (N𝒱1  ΔΓ1  EES2)"
          by (simp only: projection_def, auto)
        with N1_Delta1_E2_disjoint have "δ1''  (N𝒱1  ΔΓ1)  EES2 = []"
          by (simp add: projection_def)
        ultimately show ?thesis
          by simp
      qed
    moreover
    from δ2''_in_Nv2_Delta2_star N2_Delta2_E1_disjoint have δ2''E1_empty: "δ2''  EES1 = []"
      proof -
        from δ2''_in_Nv2_Delta2_star have "δ2'' = δ2''  (N𝒱2  ΔΓ2)"
          by (simp only: list_subset_iff_projection_neutral)
        hence "δ2''  EES1 = δ2''  (N𝒱2  ΔΓ2)  EES1"
          by simp
        moreover
        have "δ2''  (N𝒱2  ΔΓ2)  EES1 = δ2''  (N𝒱2  ΔΓ2  EES1)"
          by (simp only: projection_def, auto)
        with N2_Delta2_E1_disjoint have "δ2''  (N𝒱2  ΔΓ2)  EES1 = []"
          by (simp add: projection_def)
        ultimately show ?thesis
          by simp
      qed
    moreover
    note βE1δ1''vE1α1''_in_Tr1 βE2δ2''vE2α2''_in_Tr2 δ1''_in_E1_star δ2''_in_E2_star
    ultimately have βδ1''δ2''v'E1α1''_in_Tr1: "(β @ δ1'' @ δ2'' @ [v'])  EES1 @ α1''  TrES1"
      and βδ1''δ2''v'E2α2''_in_Tr2: "(β @ δ1'' @ δ2'' @ [v'])  EES2 @ α2''  TrES2"
      by (simp only: projection_concatenation_commute list_subset_iff_projection_neutral, auto, 
          simp only: projection_concatenation_commute list_subset_iff_projection_neutral, auto)

    have "set (β @ δ1'' @ δ2'' @ [v'])  E(ES1  ES2)"
      proof -
        from βcv'α_in_Tr have "set β  E(ES1  ES2)"
          by (simp add: composeES_def)
        moreover
        note δ1''_in_E1_star δ2''_in_E2_star
        moreover
        from v'_in_Vv_inter_Nabla VIsViewOnE
        have "v'  E(ES1  ES2)"
          by (simp add:isViewOn_def  V_valid_def
            VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
        ultimately show ?thesis
          by (simp add: composeES_def, auto)
      qed
    moreover
    have "set (α  V𝒱)  V𝒱"
      by (simp add: projection_def, auto)
    moreover
    from βE1δ1''vE1α1''_in_Tr1 validES1 have α1''_in_E1_star: "set α1''  EES1"
      by (simp add: ES_valid_def traces_contain_events_def, auto)
    moreover
    from βE2δ2''vE2α2''_in_Tr2 validES2 have α2''_in_E2_star: "set α2''  EES2"
      by (simp add: ES_valid_def traces_contain_events_def, auto)
    moreover
    note βδ1''δ2''v'E1α1''_in_Tr1 βδ1''δ2''v'E2α2''_in_Tr2
    moreover 
    have "(α  V𝒱)  EES1 = α1''  V𝒱"
      proof -
        from  α1''Vv1_is_α1'Vv1 α1'Vv1_is_αVv1 propSepViews 
        have "α  (V𝒱  EES1) = α1''  (EES1  V𝒱)"
          unfolding properSeparationOfViews_def by (simp add: Int_commute)
        hence "α  V𝒱  EES1 = α1''  EES1  V𝒱"
          by (simp add: projection_def)
        with α1''_in_E1_star show ?thesis
          by (simp add: list_subset_iff_projection_neutral)
      qed
    moreover
    have "(α  V𝒱)  EES2 = α2''  V𝒱"
      proof -
        from  α2''Vv2_is_α2'Vv2 α2'Vv2_is_αVv2 propSepViews 
        have "α  (V𝒱  EES2) = α2''  (EES2  V𝒱)"
          unfolding properSeparationOfViews_def by (simp add: Int_commute)
        hence "α  V𝒱  EES2 = α2''  EES2  V𝒱"
          by (simp add: projection_def)
        with α2''_in_E2_star show ?thesis
          by (simp add: list_subset_iff_projection_neutral)
      qed
    moreover
    note α1''Cv1_empty α2''Cv2_empty generalized_zipping_lemma
    ultimately obtain t
      where first: "(β @ δ1'' @ δ2'' @ [v']) @ t  Tr(ES1  ES2)"
      and second: "t  V𝒱 = α  V𝒱"
      and third: "t  C𝒱 = []"
      by blast
    
    from δ1''_in_Nv1_Delta1_star δ2''_in_Nv2_Delta2_star 
    have "set (δ1'' @ δ2'')  (N𝒱  ΔΓ)"
      proof -
        have "set (δ1'' @ δ2'')  ΔΓ"
          proof -
            from δ1''_in_Nv1_Delta1_star δ2''_in_Nv2_Delta2_star 
            have "set (δ1'' @ δ2'')  ΔΓ1  N𝒱1  ΔΓ2  N𝒱2"
              by auto
            with Delta1_N1_Delta2_N2_subset_Delta show ?thesis
              by auto
          qed
        moreover
        have "set (δ1'' @ δ2'')  N𝒱"
          proof -
            from δ1''_in_Nv1_Delta1_star δ2''_in_Nv2_Delta2_star 
            have "set (δ1'' @ δ2'')  (N𝒱1  N𝒱2)"
              by auto
            with Nv1_union_Nv2_subsetof_Nv show ?thesis
              by auto
          qed
        ultimately show ?thesis
          by auto
      qed
    moreover
    from first have "β @ (δ1'' @ δ2'') @ [v'] @ t  Tr(ES1  ES2)"
      by auto
    moreover 
    note second third
    ultimately have "α'. γ'. (set γ')  (N𝒱  ΔΓ) 
       ((β @ γ' @ [v'] @ α')  Tr(ES1  ES2)  
       (α'  V𝒱) = (α  V𝒱) 
       α'  C𝒱 = [])"
      by blast
  }
  thus ?thesis
    unfolding FCD_def
    by auto
qed

(* Theorem 6.4.1 case 5 *)
theorem compositionality_FCI: 
" BSD 𝒱1 TrES1; BSD 𝒱2 TrES2; BSIA ρ1 𝒱1 TrES1; BSIA ρ2 𝒱2 TrES2;
  total ES1 (C𝒱1  ΥΓ1); total ES2 (C𝒱2  ΥΓ2);Γ  EES1 Γ1;Γ  EES2 Γ2;
  ΥΓ  EES1  ΥΓ1; ΥΓ  EES2  ΥΓ2;
  ( ΔΓ1  N𝒱1  ΔΓ2  N𝒱2 )  ΔΓ;
  (N𝒱1  ΔΓ1  EES2 = {}  N𝒱2  ΔΓ2  EES1  ΥΓ1)
   ( N𝒱2  ΔΓ2  EES1 = {}  N𝒱1  ΔΓ1  EES2  ΥΓ2)  ;
  FCI Γ1 𝒱1 TrES1; FCI Γ2 𝒱2 TrES2  
   FCI Γ 𝒱 (Tr(ES1  ES2))"
proof -
  assume BSD1: "BSD 𝒱1 TrES1" 
    and BSD2: "BSD 𝒱2 TrES2"
    and BSIA1: "BSIA ρ1 𝒱1 TrES1"
    and BSIA2: "BSIA ρ2 𝒱2 TrES2"
    and total_ES1_C1_inter_Upsilon1: "total ES1 (C𝒱1  ΥΓ1)"
    and total_ES2_C2_inter_Upsilon2: "total ES2 (C𝒱2  ΥΓ2)"
    and Nabla_inter_E1_subset_Nabla1: "∇Γ  EES1 Γ1"
    and Nabla_inter_E2_subset_Nabla2: "∇Γ  EES2 Γ2"
    and Upsilon_inter_E1_subset_Upsilon1: Γ  EES1  ΥΓ1"
    and Upsilon_inter_E2_subset_Upsilon2: Γ  EES2  ΥΓ2"
    and Delta1_N1_Delta2_N2_subset_Delta: "( ΔΓ1  N𝒱1  ΔΓ2  N𝒱2 )  ΔΓ"
    and very_long_asm: "(N𝒱1  ΔΓ1  EES2 = {}  N𝒱2  ΔΓ2  EES1  ΥΓ1)
     ( N𝒱2  ΔΓ2  EES1 = {}  N𝒱1  ΔΓ1  EES2  ΥΓ2)"
    and FCI1: "FCI Γ1 𝒱1 TrES1"
    and FCI2: "FCI Γ2 𝒱2 TrES2"

  {
    fix α β c v'
    assume c_in_Cv_inter_Upsilon: "c  (C𝒱  ΥΓ)"
      and v'_in_Vv_inter_Nabla: "v'  (V𝒱 Γ)"
      and βv'α_in_Tr: "(β @ [v'] @ α)  Tr(ES1  ES2)" 
      and αCv_empty: "α  C𝒱 = []"

    from  βv'α_in_Tr
    have  βv'α_E1_in_Tr1: "(((β @ [v']) @ α)  EES1)  TrES1"
      and βv'α_E2_in_Tr2: "(((β @ [v']) @ α)  EES2)  TrES2"
      by (simp add: composeES_def)+

    interpret CSES1: CompositionSupport "ES1" "𝒱" "𝒱1"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES1 validV1)

    interpret CSES2: CompositionSupport "ES2" "𝒱" "𝒱2"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES2 validV2)

    from CSES1.BSD_in_subsystem2[OF βv'α_E1_in_Tr1 BSD1] obtain α1'
      where βv'E1α1'_in_Tr1: "(β @ [v'])  EES1 @ α1'  TrES1"
      and α1'Vv1_is_αVv1: "α1'  V𝒱1 = α  V𝒱1"
      and α1'Cv1_empty: "α1'  C𝒱1 = []"
      by auto

    from CSES2.BSD_in_subsystem2[OF βv'α_E2_in_Tr2 BSD2] obtain α2'
      where βv'E2α2'_in_Tr2: "(β @ [v'])  EES2 @ α2'  TrES2"
      and α2'Vv2_is_αVv2: "α2'  V𝒱2 = α  V𝒱2"
      and α2'Cv2_empty: "α2'  C𝒱2 = []"
      by auto

    note very_long_asm
    moreover {
      assume Nv1_inter_Delta1_inter_E2_empty: "N𝒱1  ΔΓ1  EES2 = {}" 
        and  Nv2_inter_Delta2_inter_E1_subsetof_Upsilon1: "N𝒱2  ΔΓ2  EES1  ΥΓ1"

      let ?ALPHA2''_DELTA2'' = " α2'' δ2''. (
        set α2''  EES2  set δ2''  N𝒱2  ΔΓ2 
         β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2        
         α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = [])"

      from c_in_Cv_inter_Upsilon v'_in_Vv_inter_Nabla  validV2
      have "c  EES2  (c  EES2  v'  EES2)  (c  EES2  v'  EES2)"
        by (simp add: isViewOn_def V_valid_def 
          VC_disjoint_def VN_disjoint_def NC_disjoint_def)
      moreover {
        assume c_notin_E2: "c  EES2"

        from validES2 βv'E2α2'_in_Tr2 have "set α2'  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover 
        have "set []  N𝒱2  ΔΓ2"
          by auto
        moreover 
        from βv'E2α2'_in_Tr2 c_notin_E2 
        have "β  EES2 @ [c]  EES2 @ [] @ [v']  EES2 @ α2'  TrES2"
          by (simp add: projection_def)
        moreover
        have "α2'  V𝒱2 = α2'  V𝒱2" ..
        moreover 
        note α2'Cv2_empty
        ultimately have ?ALPHA2''_DELTA2''
          by blast
      }
      moreover {
        assume c_in_E2: "c  EES2"
          and  v'_notin_E2: "v'  EES2"

        from c_in_E2 c_in_Cv_inter_Upsilon propSepViews 
          Upsilon_inter_E2_subset_Upsilon2
        have c_in_Cv2_inter_Upsilon2: "c  C𝒱2  ΥΓ2"
          unfolding properSeparationOfViews_def by auto
        hence "c  C𝒱2"
          by auto
        moreover
        from βv'E2α2'_in_Tr2 v'_notin_E2 have "β  EES2 @ α2'  TrES2"
          by (simp add: projection_def)
        moreover
        note α2'Cv2_empty
        moreover
        have "(Adm 𝒱2 ρ2 TrES2 (β  EES2) c)" 
          proof -
            from validES2 βv'E2α2'_in_Tr2 v'_notin_E2 have "β  EES2  TrES2"
              by (simp add: ES_valid_def traces_prefixclosed_def
                prefixclosed_def prefix_def projection_concatenation_commute)
            with total_ES2_C2_inter_Upsilon2 c_in_Cv2_inter_Upsilon2 
            have "β  EES2 @ [c]  TrES2"
              by (simp add: total_def)
            thus ?thesis
              unfolding Adm_def
              by blast
          qed
        moreover 
        note BSIA2
        ultimately obtain  α2''
          where one: "β  EES2 @ [c] @ α2''  TrES2"
          and two:   "α2''  V𝒱2 = α2'  V𝒱2"
          and three: "α2''  C𝒱2 = []"
          unfolding BSIA_def
          by blast

        from one validES2 have "set α2''  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        have "set []  N𝒱2  ΔΓ2"
          by auto
        moreover
        from one c_in_E2 v'_notin_E2 
        have "β  EES2 @ [c]  EES2 @ [] @ [v']  EES2 @ α2''  TrES2"
          by (simp add: projection_def)
        moreover 
        note two three
        ultimately have ?ALPHA2''_DELTA2''
          by blast
      }
      moreover {
        assume c_in_E2: "c  EES2"
          and  v'_in_E2: "v'  EES2"

        from c_in_E2 c_in_Cv_inter_Upsilon propSepViews
          Upsilon_inter_E2_subset_Upsilon2
        have c_in_Cv2_inter_Upsilon2: "c  C𝒱2  ΥΓ2"
          unfolding properSeparationOfViews_def by auto
        moreover
        from v'_in_E2 propSepViews v'_in_Vv_inter_Nabla Nabla_inter_E2_subset_Nabla2
        have "v'  V𝒱2  Nabla Γ2"
          unfolding properSeparationOfViews_def by auto
        moreover
        from v'_in_E2  βv'E2α2'_in_Tr2 have "β  EES2 @ [v'] @ α2'  TrES2"
          by (simp add: projection_def)
        moreover
        note α2'Cv2_empty FCI2
        ultimately obtain α2'' δ2''
          where one: "set δ2''  N𝒱2  ΔΓ2"
          and two: "β  EES2 @ [c] @ δ2'' @ [v'] @ α2''  TrES2"
          and three: "α2''  V𝒱2 = α2'  V𝒱2"
          and four: "α2''  C𝒱2 = []"
          unfolding FCI_def
          by blast

        from two validES2 have "set α2''  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        note one
        moreover
        from two c_in_E2 v'_in_E2 
        have "β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2"
          by (simp add: projection_def)
        moreover
        note three four
        ultimately have ?ALPHA2''_DELTA2''
          by blast
      }
      ultimately obtain α2'' δ2''
        where α2''_in_E2star: "set α2''  EES2"
        and δ2''_in_N2_inter_Delta2star:"set δ2''  N𝒱2  ΔΓ2"
        and βE2_cE2_δ2''_v'E2_α2''_in_Tr2:
              "β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2"
        and α2''Vv2_is_α2'Vv2: "α2''  V𝒱2 = α2'  V𝒱2"
        and α2''Cv2_empty: "α2''  C𝒱2 = []"
        by blast

      from c_in_Cv_inter_Upsilon Upsilon_inter_E1_subset_Upsilon1 
      propSepViews 
      have cE1_in_Cv1_inter_Upsilon1: "set ([c]  EES1)  C𝒱1  ΥΓ1"
        unfolding properSeparationOfViews_def  by (simp add: projection_def, auto)
     
      from δ2''_in_N2_inter_Delta2star Nv2_inter_Delta2_inter_E1_subsetof_Upsilon1 
        propSepViews disjoint_Nv2_Vv1 
      have δ2''E1_in_Cv1_inter_Upsilon1star: "set (δ2''  EES1)  C𝒱1  ΥΓ1"
        proof -
          from δ2''_in_N2_inter_Delta2star 
          have eq: "δ2''  EES1 = δ2''  (N𝒱2  ΔΓ2  EES1)"
            by (metis Int_commute Int_left_commute Int_lower1 Int_lower2 
              projection_intersection_neutral subset_trans)
          
          from validV1 Nv2_inter_Delta2_inter_E1_subsetof_Upsilon1 propSepViews
            disjoint_Nv2_Vv1  
          have "N𝒱2  ΔΓ2  EES1  C𝒱1  ΥΓ1"
            unfolding properSeparationOfViews_def
            by (simp add:isViewOn_def V_valid_def  VC_disjoint_def
              VN_disjoint_def NC_disjoint_def, auto)
          thus ?thesis
            by (subst eq, simp only: projection_def, auto)
        qed
      
      have cδ2''E1_in_Cv1_inter_Upsilon1star: "set ((c # δ2'')  EES1)  C𝒱1  ΥΓ1"
        proof -
          from cE1_in_Cv1_inter_Upsilon1 δ2''E1_in_Cv1_inter_Upsilon1star
          have "set (([c] @ δ2'')  EES1)  C𝒱1  ΥΓ1"
            by (simp only: projection_concatenation_commute, auto)
          thus ?thesis
            by auto
        qed


      have " α1'' δ1''. set α1''  EES1 
         set δ1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2
         β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1        
         α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []
         δ1''  EES2 = δ2''  EES1"
        proof cases
          assume v'_in_E1: "v'  EES1"
          with Nabla_inter_E1_subset_Nabla1 propSepViews v'_in_Vv_inter_Nabla
          have v'_in_Vv1_inter_Nabla1: "v'  V𝒱1  Nabla Γ1"
            unfolding properSeparationOfViews_def by auto

          have " (β @ [v'])  EES1 @ α1'  TrES1 ; 
            α1'  C𝒱1 = []; set ((c # δ2'')  EES1)  C𝒱1  ΥΓ1 ; 
            c  C𝒱  ΥΓ ; set δ2''  N𝒱2  ΔΓ2  
              α1'' δ1''. (set α1''  EES1  set δ1''  N𝒱1  ΔΓ1 
               C𝒱1  ΥΓ1  N𝒱2  ΔΓ2
             β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1            
             α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []
             δ1''  (C𝒱1  ΥΓ1) = δ2''  EES1)"
            proof (induct "length ((c # δ2'')  EES1)" arbitrary: β α1' c δ2'')
              case 0

              from 0(2) validES1 have "set α1'  EES1"
                by (simp add: ES_valid_def traces_contain_events_def, auto)
              moreover
              have "set []  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                by auto
              moreover
              have "β  EES1 @ [c]  EES1 @ [] @ [v']  EES1 @ α1'  TrES1"
                proof -
                  note 0(2)
                  moreover
                  from 0(1) have "c  EES1"
                    by (simp add: projection_def, auto)
                  ultimately show ?thesis
                    by (simp add: projection_concatenation_commute projection_def)
                qed
              moreover
              have "α1'  V𝒱1 = α1'  V𝒱1" ..
              moreover
              note 0(3)
              moreover 
              from 0(1) have "[]  (C𝒱1  ΥΓ1) = δ2''  EES1"
                by (simp add: projection_def, split if_split_asm, auto)
              ultimately show ?case
                by blast
            next
              case (Suc n)

              from projection_split_last[OF Suc(2)] obtain μ c' ν
                where c'_in_E1: "c'  EES1"
                and cδ2''_is_μc'ν: "c # δ2'' = μ @ [c'] @ ν"
                and νE1_empty: "ν  EES1 = []"
                and n_is_length_μνE1: "n = length ((μ @ ν)  EES1)"
                by blast

              from Suc(5) c'_in_E1 cδ2''_is_μc'ν 
              have "set (μ  EES1 @ [c'])  C𝒱1  ΥΓ1"
                by (simp only: cδ2''_is_μc'ν projection_concatenation_commute 
                  projection_def, auto)
              hence c'_in_Cv1_inter_Upsilon1: "c'  C𝒱1  ΥΓ1"
                by auto
              hence c'_in_Cv1: "c'  C𝒱1" and c'_in_Upsilon1: "c'  ΥΓ1"
                by auto
              with validV1 have c'_in_E1: "c'  EES1"
                by (simp add: isViewOn_def V_valid_def  VC_disjoint_def 
                  VN_disjoint_def NC_disjoint_def, auto)

              show ?case
                proof (cases μ)
                  case Nil (* we apply FCI in this case *)
                  with cδ2''_is_μc'ν have c_is_c': "c = c'" and δ2''_is_ν: "δ2'' = ν"
                    by auto
                  with c'_in_Cv1_inter_Upsilon1 have "c  C𝒱1  ΥΓ1"
                    by simp
                  moreover
                  note v'_in_Vv1_inter_Nabla1
                  moreover
                  from v'_in_E1 Suc(3) have "(β  EES1) @ [v'] @ α1'  TrES1"
                    by (simp add: projection_concatenation_commute projection_def)
                  moreover
                  note Suc(4) FCI1
                  ultimately obtain α1'' γ
                    where one: "set γ  N𝒱1  ΔΓ1"
                    and two: "β  EES1 @ [c] @ γ @ [v'] @ α1''  TrES1"
                    and three: "α1''  V𝒱1 = α1'  V𝒱1"
                    and four: "α1''  C𝒱1 = []"
                    unfolding FCI_def
                    by blast

                  (* we choose δ1'' = ν ↿ EES1 @ γ *)
                  let ?DELTA1'' = "ν  EES1 @ γ"

                  from two validES1 have "set α1''  EES1"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  from one νE1_empty 
                  have "set ?DELTA1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    by auto
                  moreover
                  have "β  EES1 @ [c]  EES1 @ ?DELTA1'' @ [v']  EES1 @ α1''  TrES1"
                    proof -
                      from c_is_c' c'_in_E1 have "[c] = [c]  EES1"
                        by (simp add: projection_def)
                      moreover
                      from v'_in_E1 have "[v'] = [v']  EES1"
                        by (simp add: projection_def)
                      moreover
                      note νE1_empty two
                      ultimately show ?thesis
                        by auto
                    qed
                  moreover
                  note three four
                  moreover
                  have "?DELTA1''  (C𝒱1  ΥΓ1) = δ2''  EES1"
                    proof -
                      have "γ  (C𝒱1  ΥΓ1) = []"
                        proof -
                          from validV1 have "N𝒱1  ΔΓ1  (C𝒱1  ΥΓ1) = {}"
                            by (simp add: isViewOn_def V_valid_def 
                              VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                          with projection_intersection_neutral[OF one, of "C𝒱1  ΥΓ1"]
                          show ?thesis
                            by (simp add: projection_def)
                        qed
                      with δ2''_is_ν νE1_empty show ?thesis
                        by (simp add: projection_concatenation_commute)
                    qed
                  ultimately show ?thesis
                    by blast
                next
                  case (Cons x xs) (* we apply the inductive hypothesis in this case *)
                  with cδ2''_is_μc'ν have μ_is_c_xs: "μ = [c] @ xs" 
                    and δ2''_is_xs_c'_ν: "δ2'' = xs @ [c'] @ ν"
                    by auto
                  with n_is_length_μνE1 have "n = length ((c # (xs @ ν))  EES1)"
                    by auto
                  moreover
                  note Suc(3,4)
                  moreover
                  have "set ((c # (xs @ ν))  EES1)  C𝒱1  ΥΓ1"
                    proof -
                      have res: "c # (xs @ ν) = [c] @ (xs @ ν)" 
                        by auto

                      from Suc(5) cδ2''_is_μc'ν μ_is_c_xs νE1_empty
                      show ?thesis
                        by (subst res, simp only: cδ2''_is_μc'ν projection_concatenation_commute 
                          set_append, auto)
                    qed
                  moreover
                  note Suc(6) 
                  moreover
                  from Suc(7) δ2''_is_xs_c'_ν have "set (xs @ ν)  N𝒱2  ΔΓ2"
                    by auto
                  moreover note Suc(1)[of c "xs @ ν" β α1']
                  ultimately obtain δ γ
                    where one: "set δ  EES1"
                    and two: "set γ  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    and three: "β  EES1 @ [c]  EES1 @ γ @ [v']  EES1 @ δ  TrES1"
                    and four: "δ  V𝒱1 = α1'  V𝒱1"
                    and five: "δ  C𝒱1 = []"
                    and six: "γ  (C𝒱1  ΥΓ1) = (xs @ ν)  EES1"
                    by blast

                  (* apply FCI to insert c' after γ *)
                  let ?BETA = "β  EES1 @ [c]  EES1 @ γ"

                  note c'_in_Cv1_inter_Upsilon1 v'_in_Vv1_inter_Nabla1
                  moreover
                  from three v'_in_E1 have "?BETA @ [v'] @ δ  TrES1"
                    by (simp add: projection_def)
                  moreover
                  note five FCI1
                  ultimately obtain α1'' δ'
                    where fci_one: "set δ'  N𝒱1  ΔΓ1"
                    and fci_two: "?BETA @ [c'] @ δ' @ [v'] @ α1''  TrES1"
                    and fci_three: "α1''  V𝒱1 = δ  V𝒱1"
                    and fci_four:  "α1''  C𝒱1 = []"
                    unfolding FCI_def
                    by blast
  
                  let ?DELTA1'' = "γ @ [c'] @ δ'"

                  from fci_two validES1 have "set α1''  EES1"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  have "set ?DELTA1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    proof -
                      from Suc(7) c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν 
                      have "c'   C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                        by auto
                      with two fci_one show ?thesis
                        by auto
                    qed
                  moreover
                  from fci_two v'_in_E1 
                  have "β  EES1 @ [c]  EES1 @ ?DELTA1'' @ [v']  EES1 @ α1''  TrES1"
                    by (simp add: projection_def)
                  moreover
                  from fci_three four have "α1''  V𝒱1 = α1'  V𝒱1"
                    by simp
                  moreover
                  note fci_four
                  moreover             
                  have "?DELTA1''  (C𝒱1  ΥΓ1) = δ2''  EES1"
                    proof -
                      have "δ'  (C𝒱1  ΥΓ1) = []"
                        proof -
                          from fci_one have " e  set δ'. e  N𝒱1  ΔΓ1"
                            by auto
                          with validV1 have " e  set δ'. e  C𝒱1  ΥΓ1"
                            by (simp add: isViewOn_def V_valid_def
                              VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                          thus ?thesis
                            by (simp add: projection_def)
                        qed
                      with c'_in_E1 c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν νE1_empty six 
                      show ?thesis
                        by (simp only: projection_concatenation_commute projection_def, auto)
                    qed
                  ultimately show ?thesis 
                    by blast     
                qed
          qed
          from this[OF βv'E1α1'_in_Tr1 α1'Cv1_empty cδ2''E1_in_Cv1_inter_Upsilon1star 
            c_in_Cv_inter_Upsilon δ2''_in_N2_inter_Delta2star]
          obtain α1'' δ1''
            where one: "set α1''  EES1"
            and two: "set δ1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
            and three: "β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1            
             α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []"
            and four: "δ1''  (C𝒱1  ΥΓ1) = δ2''  EES1"
            by blast

          note one two three
          moreover
          have "δ1''  EES2 = δ2''  EES1" 
            proof -
              from projection_intersection_neutral[OF two, of "EES2"] 
                Nv1_inter_Delta1_inter_E2_empty validV2 
              have "δ1''  EES2 = δ1''  (C𝒱1  ΥΓ1  N𝒱2  ΔΓ2  EES2)"
                by (simp only: Int_Un_distrib2, auto)
              moreover
              from validV2 
              have "C𝒱1  ΥΓ1  N𝒱2  ΔΓ2  EES2 = C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                by (simp add: isViewOn_def V_valid_def 
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
              ultimately have "δ1''  EES2 = δ1''  (C𝒱1  ΥΓ1  N𝒱2  ΔΓ2)"
                by simp
              hence "δ1''  EES2 = δ1''  (C𝒱1  ΥΓ1)  (N𝒱2  ΔΓ2)"
                by (simp add: projection_def)
              with four have "δ1''  EES2 = δ2''  EES1  (N𝒱2  ΔΓ2)"
                by simp
              hence "δ1''  EES2 = δ2''  (N𝒱2  ΔΓ2)  EES1"
                by (simp only: projection_commute)
              with δ2''_in_N2_inter_Delta2star show ?thesis
                by (simp only: list_subset_iff_projection_neutral)
            qed
          ultimately show ?thesis
              by blast
        next
          assume v'_notin_E1: "v'  EES1"

           have " (β @ [v'])  EES1 @ α1'  TrES1 ; 
            α1'  C𝒱1 = []; set ((c # δ2'')  EES1)  C𝒱1  ΥΓ1 ; 
             c  C𝒱  ΥΓ ; set δ2''  N𝒱2  ΔΓ2  
              α1'' δ1''. (set α1''  EES1  set δ1''  N𝒱1 
                 ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2
             β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1            
              α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []
             δ1''  EES2 = δ2''  EES1)"
            proof (induct "length ((c # δ2'')  EES1)" arbitrary: β α1' c δ2'')
               case 0

              from 0(2) validES1 have "set α1'  EES1"
                by (simp add: ES_valid_def traces_contain_events_def, auto)
              moreover
              have "set []  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                by auto
              moreover
              have "β  EES1 @ [c]  EES1 @ [] @ [v']  EES1 @ α1'  TrES1"
                proof -
                  note 0(2)
                  moreover
                  from 0(1) have "c  EES1"
                    by (simp add: projection_def, auto)
                  ultimately show ?thesis
                    by (simp add: projection_concatenation_commute projection_def)
                qed
              moreover
              have "α1'  V𝒱1 = α1'  V𝒱1" ..
              moreover
              note 0(3)
              moreover 
              from 0(1) have "[]  EES2 = δ2''  EES1"
                by (simp add: projection_def, split if_split_asm, auto)
              ultimately show ?case
                by blast
            next
              case (Suc n)

              from projection_split_last[OF Suc(2)] obtain μ c' ν
                where c'_in_E1: "c'  EES1"
                and cδ2''_is_μc'ν: "c # δ2'' = μ @ [c'] @ ν"
                and νE1_empty: "ν  EES1 = []"
                and n_is_length_μνE1: "n = length ((μ @ ν)  EES1)"
                by blast

              from Suc(5) c'_in_E1 cδ2''_is_μc'ν 
              have "set (μ  EES1 @ [c'])  C𝒱1  ΥΓ1"
                by (simp only: cδ2''_is_μc'ν projection_concatenation_commute 
                  projection_def, auto)
              hence c'_in_Cv1_inter_Upsilon1: "c'  C𝒱1  ΥΓ1"
                by auto
              hence c'_in_Cv1: "c'  C𝒱1" and c'_in_Upsilon1: "c'  ΥΓ1"
                by auto
              with validV1 have c'_in_E1: "c'  EES1"
                by (simp add: isViewOn_def V_valid_def
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)

              show ?case
                proof (cases μ)
                  case Nil (* we just apply BSIA in this case *)
                  with cδ2''_is_μc'ν have c_is_c': "c = c'" 
                    and δ2''_is_ν: "δ2'' = ν"
                    by auto
                  with c'_in_Cv1_inter_Upsilon1 have "c  C𝒱1"
                    by simp
                  moreover
                  from v'_notin_E1 Suc(3) have "(β  EES1) @ α1'  TrES1"
                    by (simp add: projection_concatenation_commute projection_def)
                  moreover
                  note Suc(4)
                  moreover
                  have "Adm 𝒱1 ρ1 TrES1 (β  EES1) c"
                    proof -
                      have "β  EES1 @ [c]  TrES1"
                        proof -
                          from c_is_c' c'_in_Cv1_inter_Upsilon1 
                          have "c  C𝒱1  ΥΓ1"
                            by simp
                          moreover
                          from validES1 Suc(3) 
                          have "(β  EES1)  TrES1"
                            by (simp only: ES_valid_def traces_prefixclosed_def
                              projection_concatenation_commute 
                              prefixclosed_def prefix_def, auto)
                          moreover
                          note total_ES1_C1_inter_Upsilon1
                          ultimately show ?thesis
                            unfolding total_def
                            by blast
                        qed
                      thus ?thesis
                        unfolding Adm_def
                        by blast                        
                    qed
                  moreover
                  note BSIA1
                  ultimately obtain α1''
                    where one: "(β  EES1) @ [c] @ α1''  TrES1"
                    and two: "α1''  V𝒱1 = α1'  V𝒱1"
                    and three: "α1''  C𝒱1 = []"
                    unfolding BSIA_def
                    by blast

                  let ?DELTA1'' = "ν  EES1"

                  from one validES1 have "set α1''  EES1"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  from νE1_empty
                  have "set ?DELTA1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    by simp
                  moreover
                  from c_is_c' c'_in_E1 one v'_notin_E1 νE1_empty
                  have "(β  EES1) @ [c]  EES1 @ ?DELTA1'' @ [v']  EES1 @ α1''  TrES1"
                    by (simp add: projection_def)
                  moreover
                  note two three
                  moreover
                  from νE1_empty δ2''_is_ν have "?DELTA1''  EES2 = δ2''  EES1"
                    by (simp add: projection_def)
                  ultimately show ?thesis
                    by blast
                next
                  case (Cons x xs) (* apply inductive hypothesis, then BSIA *)
                  with cδ2''_is_μc'ν
                  have μ_is_c_xs: "μ = [c] @ xs" and δ2''_is_xs_c'_ν: "δ2'' = xs @ [c'] @ ν"
                    by auto
                  with n_is_length_μνE1 have "n = length ((c # (xs @ ν))  EES1)"
                    by auto
                  moreover
                  note Suc(3,4)
                  moreover
                  have "set ((c # (xs @ ν))  EES1)  C𝒱1  ΥΓ1"
                    proof -
                      have res: "c # (xs @ ν) = [c] @ (xs @ ν)" 
                        by auto

                      from Suc(5) cδ2''_is_μc'ν μ_is_c_xs νE1_empty
                      show ?thesis
                        by (subst res, simp only: cδ2''_is_μc'ν projection_concatenation_commute 
                          set_append, auto)
                    qed
                  moreover
                  note Suc(6) 
                  moreover
                  from Suc(7) δ2''_is_xs_c'_ν have "set (xs @ ν)  N𝒱2  ΔΓ2"
                    by auto
                  moreover note Suc(1)[of c "xs @ ν" β α1']
                  ultimately obtain δ γ
                    where one: "set δ  EES1"
                    and two: "set γ  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    and three: "β  EES1 @ [c]  EES1 @ γ @ [v']  EES1 @ δ  TrES1"
                    and four: "δ  V𝒱1 = α1'  V𝒱1"
                    and five: "δ  C𝒱1 = []"
                    and six: "γ  EES2 = (xs @ ν)  EES1"
                    by blast
                  
                   (* apply BSIA to insert c' after γ *)
                  let ?BETA = "β  EES1 @ [c]  EES1 @ γ"

                  from c'_in_Cv1_inter_Upsilon1 have "c'  C𝒱1"
                    by auto
                  moreover
                  from three v'_notin_E1 have "?BETA @ δ  TrES1"
                    by (simp add: projection_def)
                  moreover
                  note five 
                  moreover
                  have "Adm 𝒱1 ρ1 TrES1 ?BETA c'"
                    proof -
                      have "?BETA @ [c']  TrES1"
                        proof -
                          from validES1 three 
                          have "?BETA  TrES1"
                            by (simp only: ES_valid_def traces_prefixclosed_def
                              projection_concatenation_commute 
                              prefixclosed_def prefix_def, auto)
                          moreover
                          note c'_in_Cv1_inter_Upsilon1 total_ES1_C1_inter_Upsilon1
                          ultimately show ?thesis
                            unfolding total_def
                            by blast
                        qed
                      thus ?thesis
                        unfolding Adm_def
                        by blast                        
                    qed
                  moreover
                  note BSIA1
                  ultimately obtain α1''
                    where bsia_one: "?BETA @ [c'] @ α1''  TrES1"
                    and bsia_two: "α1''  V𝒱1 = δ  V𝒱1"
                    and bsia_three:  "α1''  C𝒱1 = []"
                    unfolding BSIA_def
                    by blast
  
                  let ?DELTA1'' = "γ @ [c']"

                  from bsia_one validES1 have "set α1''  EES1"
                    by (simp add:isViewOn_def ES_valid_def traces_contain_events_def, auto)
                  moreover
                  have "set ?DELTA1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    proof -
                      from Suc(7) c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν 
                      have "c'   C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                        by auto
                      with two show ?thesis
                        by auto
                    qed
                  moreover
                  from bsia_one v'_notin_E1 
                  have "β  EES1 @ [c]  EES1 @ ?DELTA1'' @ [v']  EES1 @ α1''  TrES1"
                    by (simp add: projection_def)
                  moreover
                  from bsia_two four have "α1''  V𝒱1 = α1'  V𝒱1"
                    by simp
                  moreover
                  note bsia_three
                  moreover             
                  have "?DELTA1''  EES2 = δ2''  EES1"
                    proof -
                      from validV2 Suc(7) δ2''_is_xs_c'_ν 
                      have "c'  EES2"
                        by (simp add: isViewOn_def V_valid_def
                          VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                      with c'_in_E1 c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν νE1_empty six 
                      show ?thesis
                        by (simp only: projection_concatenation_commute projection_def, auto)
                    qed
                  ultimately show ?thesis 
                    by blast     
                qed
            qed
          from this[OF βv'E1α1'_in_Tr1 α1'Cv1_empty cδ2''E1_in_Cv1_inter_Upsilon1star 
            c_in_Cv_inter_Upsilon δ2''_in_N2_inter_Delta2star]
          show ?thesis 
            by blast
        qed
      then obtain α1'' δ1''
        where α1''_in_E1star: "set α1''  EES1"
        and δ1''_in_N1_inter_Delta1star:"set δ1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
        and βE1_cE1_δ1''_v'E1_α1''_in_Tr1: 
        "β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1"
        and α1''Vv1_is_α1'Vv1: "α1''  V𝒱1 = α1'  V𝒱1"
        and α1''Cv1_empty: "α1''  C𝒱1 = []"
        and δ1''E2_is_δ2''E1: "δ1''  EES2 = δ2''  EES1"
        by blast

      from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 βE2_cE2_δ2''_v'E2_α2''_in_Tr2 
        validES1 validES2
      have δ1''_in_E1star: "set δ1''  EES1" and δ2''_in_E2star: "set δ2''  EES2"
        by (simp_all add: ES_valid_def traces_contain_events_def, auto)
      with δ1''E2_is_δ2''E1 merge_property[of δ1'' "EES1" δ2'' "EES2"] obtain δ'
        where δ'E1_is_δ1'': "δ'  EES1 = δ1''"
        and δ'E2_is_δ2'': "δ'  EES2 = δ2''"
        and δ'_contains_only_δ1''_δ2''_events: "set δ'  set δ1''  set δ2''"
        unfolding Let_def
        by auto

      let ?TAU = "β @ [c] @ δ' @ [v']"
      let ?LAMBDA = "α  V𝒱"
      let ?T1 = α1''
      let ?T2 = α2''

     (* apply the generalized zipping lemma *)
     have "?TAU  Tr(ES1  ES2)"
        proof -
          from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 δ'E1_is_δ1'' validES1 
          have "β  EES1 @ [c]  EES1 @ δ'  EES1 @ [v']  EES1  TrES1"
            by (simp add: ES_valid_def traces_prefixclosed_def
              prefixclosed_def prefix_def)
          hence "(β @ [c] @ δ' @ [v'])  EES1  TrES1"
            by (simp add: projection_def, auto)
          moreover          
          from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 δ'E2_is_δ2'' validES2 
          have "β  EES2 @ [c]  EES2 @ δ'  EES2 @ [v']  EES2  TrES2"
            by (simp add: ES_valid_def traces_prefixclosed_def
              prefixclosed_def prefix_def)
          hence "(β @ [c] @ δ' @ [v'])  EES2  TrES2"
            by (simp add: projection_def, auto)
          moreover
          from βv'α_in_Tr c_in_Cv_inter_Upsilon VIsViewOnE
            δ'_contains_only_δ1''_δ2''_events δ1''_in_E1star δ2''_in_E2star
          have "set (β @ [c] @ δ' @ [v'])  EES1  EES2"
            unfolding composeES_def isViewOn_def V_valid_def 
              VC_disjoint_def VN_disjoint_def NC_disjoint_def
            by auto
          ultimately show ?thesis
            unfolding composeES_def
            by auto
        qed 
      hence "set ?TAU  E(ES1  ES2)"
        unfolding composeES_def
        by auto
      moreover
      have "set ?LAMBDA  V𝒱"
        by (simp add: projection_def, auto)
      moreover
      note α1''_in_E1star α2''_in_E2star
      moreover
      from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 δ'E1_is_δ1'' 
      have "?TAU  EES1 @ ?T1  TrES1"
        by (simp only: projection_concatenation_commute, auto)
      moreover
      from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 δ'E2_is_δ2'' 
      have "?TAU  EES2 @ ?T2  TrES2"
        by (simp only: projection_concatenation_commute, auto)
      moreover
      have "?LAMBDA  EES1 = ?T1  V𝒱"
        proof -
          from propSepViews have "?LAMBDA  EES1 = α  V𝒱1"
            unfolding properSeparationOfViews_def by (simp add: projection_sequence)
          moreover
          from α1''_in_E1star propSepViews 
          have "?T1  V𝒱 = ?T1  V𝒱1"
            unfolding properSeparationOfViews_def 
            by (metis Int_commute projection_intersection_neutral)
          moreover
          note α1'Vv1_is_αVv1 α1''Vv1_is_α1'Vv1
          ultimately show ?thesis
            by simp
        qed
      moreover
      have "?LAMBDA  EES2 = ?T2  V𝒱"
        proof -
          from propSepViews 
          have "?LAMBDA  EES2 = α  V𝒱2"
            unfolding properSeparationOfViews_def  by (simp add: projection_sequence)
          moreover
          from α2''_in_E2star propSepViews 
          have "?T2  V𝒱 = ?T2  V𝒱2"
            unfolding properSeparationOfViews_def
            by (metis Int_commute projection_intersection_neutral)
          moreover
          note α2'Vv2_is_αVv2 α2''Vv2_is_α2'Vv2
          ultimately show ?thesis
            by simp
        qed
      moreover
      note α1''Cv1_empty α2''Cv2_empty generalized_zipping_lemma
      ultimately obtain t (* show that the conclusion of FCI holds *)
        where "?TAU @ t  Tr(ES1  ES2)"
        and  "t  V𝒱 = ?LAMBDA"
        and "t  C𝒱 = []"
        by blast
      moreover
      have "set δ'  N𝒱  ΔΓ"
        proof -
          from δ'_contains_only_δ1''_δ2''_events 
            δ1''_in_N1_inter_Delta1star δ2''_in_N2_inter_Delta2star
          have "set δ'  N𝒱1  ΔΓ1  N𝒱2  ΔΓ2"
            by auto
          with Delta1_N1_Delta2_N2_subset_Delta Nv1_union_Nv2_subsetof_Nv 
          show ?thesis
            by auto
        qed
        ultimately
        have "α' γ'. (set γ'  N𝒱  ΔΓ  β @ [c] @ γ' @ [v'] @ α'  Tr(ES1  ES2) 
                     α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])"
        by (simp only: append_assoc, blast)
    }
    moreover {
      assume Nv2_inter_Delta2_inter_E1_empty: "N𝒱2  ΔΓ2  EES1 = {}" 
        and  Nv1_inter_Delta1_inter_E2_subsetof_Upsilon2: "N𝒱1  ΔΓ1  EES2  ΥΓ2"

      let ?ALPHA1''_DELTA1'' = " α1'' δ1''. (
        set α1''  EES1  set δ1''  N𝒱1  ΔΓ1 
         β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1        
         α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = [])"

      from c_in_Cv_inter_Upsilon v'_in_Vv_inter_Nabla validV1
      have "c  EES1  (c  EES1  v'  EES1)  (c  EES1  v'  EES1)"
        by (simp add: isViewOn_def V_valid_def 
          VC_disjoint_def VN_disjoint_def NC_disjoint_def)
      moreover {
        assume c_notin_E1: "c  EES1"

        from validES1 βv'E1α1'_in_Tr1 have "set α1'  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover 
        have "set []  N𝒱1  ΔΓ1"
          by auto
        moreover 
        from βv'E1α1'_in_Tr1 c_notin_E1 
        have "β  EES1 @ [c]  EES1 @ [] @ [v']  EES1 @ α1'  TrES1"
          by (simp add: projection_def)
        moreover
        have "α1'  V𝒱1 = α1'  V𝒱1" ..
        moreover 
        note α1'Cv1_empty
        ultimately have ?ALPHA1''_DELTA1''
          by blast
      }
      moreover {
        assume c_in_E1: "c  EES1"
          and  v'_notin_E1: "v'  EES1"

        from c_in_E1 c_in_Cv_inter_Upsilon propSepViews
          Upsilon_inter_E1_subset_Upsilon1
        have c_in_Cv1_inter_Upsilon1: "c  C𝒱1  ΥΓ1"
          unfolding properSeparationOfViews_def by auto
        hence "c  C𝒱1"
          by auto
        moreover
        from βv'E1α1'_in_Tr1 v'_notin_E1 have "β  EES1 @ α1'  TrES1"
          by (simp add: projection_def)
        moreover
        note α1'Cv1_empty
        moreover
        have "(Adm 𝒱1 ρ1 TrES1 (β  EES1) c)" 
          proof -
            from validES1 βv'E1α1'_in_Tr1 v'_notin_E1 have "β  EES1  TrES1"
              by (simp add: ES_valid_def traces_prefixclosed_def
                prefixclosed_def prefix_def projection_concatenation_commute)
            with total_ES1_C1_inter_Upsilon1 c_in_Cv1_inter_Upsilon1
            have "β  EES1 @ [c]  TrES1"
              by (simp add: total_def)
            thus ?thesis
              unfolding Adm_def
              by blast
          qed
        moreover 
        note BSIA1
        ultimately obtain  α1''
          where one: "β  EES1 @ [c] @ α1''  TrES1"
          and two:   "α1''  V𝒱1 = α1'  V𝒱1"
          and three: "α1''  C𝒱1 = []"
          unfolding BSIA_def
          by blast

        from one validES1 have "set α1''  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        have "set []  N𝒱1  ΔΓ1"
          by auto
        moreover
        from one c_in_E1 v'_notin_E1 
        have "β  EES1 @ [c]  EES1 @ [] @ [v']  EES1 @ α1''  TrES1"
          by (simp add: projection_def)
        moreover 
        note two three
        ultimately have ?ALPHA1''_DELTA1''
          by blast
      }
      moreover {
        assume c_in_E1: "c  EES1"
          and  v'_in_E1: "v'  EES1"

        from c_in_E1 c_in_Cv_inter_Upsilon propSepViews
          Upsilon_inter_E1_subset_Upsilon1
        have c_in_Cv1_inter_Upsilon1: "c  C𝒱1  ΥΓ1"
          unfolding properSeparationOfViews_def by auto
        moreover
        from v'_in_E1 propSepViews v'_in_Vv_inter_Nabla Nabla_inter_E1_subset_Nabla1
        have "v'  V𝒱1  Nabla Γ1"
         unfolding properSeparationOfViews_def by auto
        moreover
        from v'_in_E1  βv'E1α1'_in_Tr1 have "β  EES1 @ [v'] @ α1'  TrES1"
          by (simp add: projection_def)
        moreover
        note α1'Cv1_empty FCI1
        ultimately obtain α1'' δ1''
          where one: "set δ1''  N𝒱1  ΔΓ1"
          and two: "β  EES1 @ [c] @ δ1'' @ [v'] @ α1''  TrES1"
          and three: "α1''  V𝒱1 = α1'  V𝒱1"
          and four: "α1''  C𝒱1 = []"
          unfolding FCI_def
          by blast

        from two validES1 have "set α1''  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        note one
        moreover
        from two c_in_E1 v'_in_E1 
        have "β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1"
          by (simp add: projection_def)
        moreover
        note three four
        ultimately have ?ALPHA1''_DELTA1''
          by blast
      }
      ultimately obtain α1'' δ1''
        where α1''_in_E1star: "set α1''  EES1"
        and δ1''_in_N1_inter_Delta1star:"set δ1''  N𝒱1  ΔΓ1"
        and βE1_cE1_δ1''_v'E1_α1''_in_Tr1: 
        "β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1"
        and α1''Vv1_is_α1'Vv1: "α1''  V𝒱1 = α1'  V𝒱1"
        and α1''Cv1_empty: "α1''  C𝒱1 = []"
        by blast

      from c_in_Cv_inter_Upsilon Upsilon_inter_E2_subset_Upsilon2 propSepViews 
      have cE2_in_Cv2_inter_Upsilon2: "set ([c]  EES2)  C𝒱2  ΥΓ2"
        unfolding properSeparationOfViews_def by (simp add: projection_def, auto)
     
      from δ1''_in_N1_inter_Delta1star Nv1_inter_Delta1_inter_E2_subsetof_Upsilon2 
        propSepViews disjoint_Nv1_Vv2 
      have δ1''E2_in_Cv2_inter_Upsilon2star: "set (δ1''  EES2)  C𝒱2  ΥΓ2"
        proof -
          from δ1''_in_N1_inter_Delta1star have eq: "δ1''  EES2 = δ1''  (N𝒱1  ΔΓ1  EES2)"
            by (metis Int_commute Int_left_commute Int_lower2 Int_lower1 
              projection_intersection_neutral subset_trans)
          
          from validV2 Nv1_inter_Delta1_inter_E2_subsetof_Upsilon2 
           propSepViews disjoint_Nv1_Vv2  
          have "N𝒱1  ΔΓ1  EES2  C𝒱2  ΥΓ2"
            unfolding properSeparationOfViews_def
            by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
              VN_disjoint_def NC_disjoint_def, auto)
          thus ?thesis
            by (subst eq, simp only: projection_def, auto)
        qed
      
      have cδ1''E2_in_Cv2_inter_Upsilon2star: "set ((c # δ1'')  EES2)  C𝒱2  ΥΓ2"
        proof -
          from cE2_in_Cv2_inter_Upsilon2 δ1''E2_in_Cv2_inter_Upsilon2star
          have "set (([c] @ δ1'')  EES2)  C𝒱2  ΥΓ2"
            by (simp only: projection_concatenation_commute, auto)
          thus ?thesis
            by auto
        qed


      have " α2'' δ2''. set α2''  EES2        
         set δ2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1        
         β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2        
         α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []
         δ2''  EES1 = δ1''  EES2"
        proof cases
          assume v'_in_E2: "v'  EES2"
          with Nabla_inter_E2_subset_Nabla2 
            propSepViews v'_in_Vv_inter_Nabla
          have v'_in_Vv2_inter_Nabla2: "v'  V𝒱2  Nabla Γ2"
            unfolding properSeparationOfViews_def by auto

          have " (β @ [v'])  EES2 @ α2'  TrES2 ; 
            α2'  C𝒱2 = []; set ((c # δ1'')  EES2)  C𝒱2  ΥΓ2 ; 
            c  C𝒱  ΥΓ ; set δ1''  N𝒱1  ΔΓ1  
              α2'' δ2''. (set α2''  EES2  set δ2''  N𝒱2  ΔΓ2  C𝒱2 
               ΥΓ2  N𝒱1  ΔΓ1            
             β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2            
             α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []
             δ2''  (C𝒱2  ΥΓ2) = δ1''  EES2)"
            proof (induct "length ((c # δ1'')  EES2)" arbitrary: β α2' c δ1'')
              case 0

              from 0(2) validES2 have "set α2'  EES2"
                by (simp add: ES_valid_def traces_contain_events_def, auto)
              moreover
              have "set []  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                by auto
              moreover
              have "β  EES2 @ [c]  EES2 @ [] @ [v']  EES2 @ α2'  TrES2"
                proof -
                  note 0(2)
                  moreover
                  from 0(1) have "c  EES2"
                    by (simp add: projection_def, auto)
                  ultimately show ?thesis
                    by (simp add: projection_concatenation_commute projection_def)
                qed
              moreover
              have "α2'  V𝒱2 = α2'  V𝒱2" ..
              moreover
              note 0(3)
              moreover 
              from 0(1) have "[]  (C𝒱2  ΥΓ2) = δ1''  EES2"
                by (simp add: projection_def, split if_split_asm, auto)
              ultimately show ?case
                by blast
            next
              case (Suc n)

              from projection_split_last[OF Suc(2)] obtain μ c' ν
                where c'_in_E2: "c'  EES2"
                and cδ1''_is_μc'ν: "c # δ1'' = μ @ [c'] @ ν"
                and νE2_empty: "ν  EES2 = []"
                and n_is_length_μνE2: "n = length ((μ @ ν)  EES2)"
                by blast

              from Suc(5) c'_in_E2 cδ1''_is_μc'ν 
              have "set (μ  EES2 @ [c'])  C𝒱2  ΥΓ2"
                by (simp only: cδ1''_is_μc'ν projection_concatenation_commute 
                  projection_def, auto)
              hence c'_in_Cv2_inter_Upsilon2: "c'  C𝒱2  ΥΓ2"
                by auto
              hence c'_in_Cv2: "c'  C𝒱2" and c'_in_Upsilon2: "c'  ΥΓ2"
                by auto
              with validV2 have c'_in_E2: "c'  EES2"
                by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
                  VN_disjoint_def NC_disjoint_def, auto)

              show ?case
                proof (cases μ)
                  case Nil (* we apply FCI in this case *)
                  with cδ1''_is_μc'ν have c_is_c': "c = c'" and δ1''_is_ν: "δ1'' = ν"
                    by auto
                  with c'_in_Cv2_inter_Upsilon2 have "c  C𝒱2  ΥΓ2"
                    by simp
                  moreover
                  note v'_in_Vv2_inter_Nabla2
                  moreover
                  from v'_in_E2 Suc(3) have "(β  EES2) @ [v'] @ α2'  TrES2"
                    by (simp add: projection_concatenation_commute projection_def)
                  moreover
                  note Suc(4) FCI2
                  ultimately obtain α2'' γ
                    where one: "set γ  N𝒱2  ΔΓ2"
                    and two: "β  EES2 @ [c] @ γ @ [v'] @ α2''  TrES2"
                    and three: "α2''  V𝒱2 = α2'  V𝒱2"
                    and four: "α2''  C𝒱2 = []"
                    unfolding FCI_def
                    by blast

                  (* we choose δ2'' = ν ↿ EES2 @ γ *)
                  let ?DELTA2'' = "ν  EES2 @ γ"

                  from two validES2 have "set α2''  EES2"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  from one νE2_empty
                  have "set ?DELTA2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    by auto
                  moreover
                  have "β  EES2 @ [c]  EES2 @ ?DELTA2'' @ [v']  EES2 @ α2''  TrES2"
                    proof -
                      from c_is_c' c'_in_E2 have "[c] = [c]  EES2"
                        by (simp add: projection_def)
                      moreover
                      from v'_in_E2 have "[v'] = [v']  EES2"
                        by (simp add: projection_def)
                      moreover
                      note νE2_empty two
                      ultimately show ?thesis
                        by auto
                    qed
                  moreover
                  note three four
                  moreover
                  have "?DELTA2''  (C𝒱2  ΥΓ2) = δ1''  EES2"
                    proof -
                      have "γ  (C𝒱2  ΥΓ2) = []"
                        proof -
                          from validV2 have "N𝒱2  ΔΓ2  (C𝒱2  ΥΓ2) = {}"
                            by (simp add: isViewOn_def V_valid_def
                              VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                          with projection_intersection_neutral[OF one, of "C𝒱2  ΥΓ2"]
                          show ?thesis
                            by (simp add: projection_def)
                        qed
                      with δ1''_is_ν νE2_empty show ?thesis
                        by (simp add: projection_concatenation_commute)
                    qed
                  ultimately show ?thesis
                    by blast
                next
                  case (Cons x xs) (* we apply the inductive hypothesis in this case *)
                  with cδ1''_is_μc'ν have μ_is_c_xs: "μ = [c] @ xs" 
                    and δ1''_is_xs_c'_ν: "δ1'' = xs @ [c'] @ ν"
                    by auto
                  with n_is_length_μνE2 have "n = length ((c # (xs @ ν))  EES2)"
                    by auto
                  moreover
                  note Suc(3,4)
                  moreover
                  have "set ((c # (xs @ ν))  EES2)  C𝒱2  ΥΓ2"
                    proof -
                      have res: "c # (xs @ ν) = [c] @ (xs @ ν)" 
                        by auto

                      from Suc(5) cδ1''_is_μc'ν μ_is_c_xs νE2_empty
                      show ?thesis
                        by (subst res, simp only: cδ1''_is_μc'ν 
                          projection_concatenation_commute set_append, auto)
                    qed
                  moreover
                  note Suc(6) 
                  moreover
                  from Suc(7) δ1''_is_xs_c'_ν have "set (xs @ ν)  N𝒱1  ΔΓ1"
                    by auto
                  moreover note Suc(1)[of c "xs @ ν" β α2']
                  ultimately obtain δ γ
                    where one: "set δ  EES2"
                    and two: "set γ  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    and three: "β  EES2 @ [c]  EES2 @ γ @ [v']  EES2 @ δ  TrES2"
                    and four: "δ  V𝒱2 = α2'  V𝒱2"
                    and five: "δ  C𝒱2 = []"
                    and six: "γ  (C𝒱2  ΥΓ2) = (xs @ ν)  EES2"
                    by blast

                  (* apply FCI to insert c' after γ *)
                  let ?BETA = "β  EES2 @ [c]  EES2 @ γ"

                  note c'_in_Cv2_inter_Upsilon2 v'_in_Vv2_inter_Nabla2
                  moreover
                  from three v'_in_E2 have "?BETA @ [v'] @ δ  TrES2"
                    by (simp add: projection_def)
                  moreover
                  note five FCI2
                  ultimately obtain α2'' δ'
                    where fci_one: "set δ'  N𝒱2  ΔΓ2"
                    and fci_two: "?BETA @ [c'] @ δ' @ [v'] @ α2''  TrES2"
                    and fci_three: "α2''  V𝒱2 = δ  V𝒱2"
                    and fci_four:  "α2''  C𝒱2 = []"
                    unfolding FCI_def
                    by blast
  
                  let ?DELTA2'' = "γ @ [c'] @ δ'"

                  from fci_two validES2 have "set α2''  EES2"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  have "set ?DELTA2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    proof -
                      from Suc(7) c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν 
                      have "c'   C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                        by auto
                      with two fci_one show ?thesis
                        by auto
                    qed
                  moreover
                  from fci_two v'_in_E2 
                  have "β  EES2 @ [c]  EES2 @ ?DELTA2'' @ [v']  EES2 @ α2''  TrES2"
                    by (simp add: projection_def)
                  moreover
                  from fci_three four have "α2''  V𝒱2 = α2'  V𝒱2"
                    by simp
                  moreover
                  note fci_four
                  moreover             
                  have "?DELTA2''  (C𝒱2  ΥΓ2) = δ1''  EES2"
                    proof -
                      have "δ'  (C𝒱2  ΥΓ2) = []"
                        proof -
                          from fci_one have " e  set δ'. e  N𝒱2  ΔΓ2"
                            by auto
                          with validV2 have " e  set δ'. e  C𝒱2  ΥΓ2"
                            by (simp add: isViewOn_def V_valid_def
                              VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                          thus ?thesis
                            by (simp add: projection_def)
                        qed
                      with c'_in_E2 c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν νE2_empty six 
                      show ?thesis
                        by (simp only: projection_concatenation_commute projection_def, auto)
                    qed
                  ultimately show ?thesis 
                    by blast     
                qed
          qed
          from this[OF βv'E2α2'_in_Tr2 α2'Cv2_empty cδ1''E2_in_Cv2_inter_Upsilon2star 
            c_in_Cv_inter_Upsilon δ1''_in_N1_inter_Delta1star]
          obtain α2'' δ2''
            where one: "set α2''  EES2"
            and two: "set δ2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
            and three: "β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2            
             α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []"
            and four: "δ2''  (C𝒱2  ΥΓ2) = δ1''  EES2"
            by blast

          note one two three
          moreover
          have "δ2''  EES1 = δ1''  EES2" 
            proof -
              from projection_intersection_neutral[OF two, of "EES1"] 
                Nv2_inter_Delta2_inter_E1_empty validV1 
              have "δ2''  EES1 = δ2''  (C𝒱2  ΥΓ2  N𝒱1  ΔΓ1  EES1)"
                by (simp only: Int_Un_distrib2, auto)
              moreover
              from validV1 
              have "C𝒱2  ΥΓ2  N𝒱1  ΔΓ1  EES1 = C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
                  VN_disjoint_def NC_disjoint_def, auto)
              ultimately have "δ2''  EES1 = δ2''  (C𝒱2  ΥΓ2  N𝒱1  ΔΓ1)"
                by simp
              hence "δ2''  EES1 = δ2''  (C𝒱2  ΥΓ2)  (N𝒱1  ΔΓ1)"
                by (simp add: projection_def)
              with four have "δ2''  EES1 = δ1''  EES2  (N𝒱1  ΔΓ1)"
                by simp
              hence "δ2''  EES1 = δ1''  (N𝒱1  ΔΓ1)  EES2"
                by (simp only: projection_commute)
              with δ1''_in_N1_inter_Delta1star show ?thesis
                by (simp only: list_subset_iff_projection_neutral)
            qed
          ultimately show ?thesis
              by blast
        next
          assume v'_notin_E2: "v'  EES2"

          have 
            " (β @ [v'])  EES2 @ α2'  TrES2 ; α2'  C𝒱2 = []; 
                set ((c # δ1'')  EES2)  C𝒱2  ΥΓ2 ; c  C𝒱  ΥΓ ;
                set δ1''  N𝒱1  ΔΓ1  
              α2'' δ2''.
             (set α2''  EES2  set δ2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1            
              β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2             
              α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []
             δ2''  EES1 = δ1''  EES2)"
            proof (induct "length ((c # δ1'')  EES2)" arbitrary: β α2' c δ1'')
               case 0

              from 0(2) validES2 have "set α2'  EES2"
                by (simp add: ES_valid_def traces_contain_events_def, auto)
              moreover
              have "set []  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                by auto
              moreover
              have "β  EES2 @ [c]  EES2 @ [] @ [v']  EES2 @ α2'  TrES2"
                proof -
                  note 0(2)
                  moreover
                  from 0(1) have "c  EES2"
                    by (simp add: projection_def, auto)
                  ultimately show ?thesis
                    by (simp add: projection_concatenation_commute projection_def)
                qed
              moreover
              have "α2'  V𝒱2 = α2'  V𝒱2" ..
              moreover
              note 0(3)
              moreover 
              from 0(1) have "[]  EES1 = δ1''  EES2"
                by (simp add: projection_def, split if_split_asm, auto)
              ultimately show ?case
                by blast
            next
              case (Suc n)

              from projection_split_last[OF Suc(2)] obtain μ c' ν
                where c'_in_E2: "c'  EES2"
                and cδ1''_is_μc'ν: "c # δ1'' = μ @ [c'] @ ν"
                and νE2_empty: "ν  EES2 = []"
                and n_is_length_μνE2: "n = length ((μ @ ν)  EES2)"
                by blast

              from Suc(5) c'_in_E2 cδ1''_is_μc'ν have "set (μ  EES2 @ [c'])  C𝒱2  ΥΓ2"
                by (simp only: cδ1''_is_μc'ν projection_concatenation_commute projection_def, auto)
              hence c'_in_Cv2_inter_Upsilon2: "c'  C𝒱2  ΥΓ2"
                by auto
              hence c'_in_Cv2: "c'  C𝒱2" and c'_in_Upsilon2: "c'  ΥΓ2"
                by auto
              with validV2 have c'_in_E2: "c'  EES2"
                by (simp add: isViewOn_def V_valid_def VC_disjoint_def
                  VN_disjoint_def NC_disjoint_def, auto)

              show ?case
                proof (cases μ)
                  case Nil (* we just apply BSIA in this case *)
                  with cδ1''_is_μc'ν have c_is_c': "c = c'" and δ1''_is_ν: "δ1'' = ν"
                    by auto
                  with c'_in_Cv2_inter_Upsilon2 have "c  C𝒱2"
                    by simp
                  moreover
                  from v'_notin_E2 Suc(3) have "(β  EES2) @ α2'  TrES2"
                    by (simp add: projection_concatenation_commute projection_def)
                  moreover
                  note Suc(4)
                  moreover
                  have "Adm 𝒱2 ρ2 TrES2 (β  EES2) c"
                    proof -
                      have "β  EES2 @ [c]  TrES2"
                        proof -
                          from c_is_c' c'_in_Cv2_inter_Upsilon2 have "c  C𝒱2  ΥΓ2"
                            by simp
                          moreover
                          from validES2 Suc(3) have "(β  EES2)  TrES2"
                            by (simp only: ES_valid_def traces_prefixclosed_def
                              projection_concatenation_commute 
                              prefixclosed_def prefix_def, auto)
                          moreover
                          note total_ES2_C2_inter_Upsilon2
                          ultimately show ?thesis
                            unfolding total_def
                            by blast
                        qed
                      thus ?thesis
                        unfolding Adm_def
                        by blast                        
                    qed
                  moreover
                  note BSIA2
                  ultimately obtain α2''
                    where one: "(β  EES2) @ [c] @ α2''  TrES2"
                    and two: "α2''  V𝒱2 = α2'  V𝒱2"
                    and three: "α2''  C𝒱2 = []"
                    unfolding BSIA_def
                    by blast

                  let ?DELTA2'' = "ν  EES2"

                  from one validES2 have "set α2''  EES2"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  from νE2_empty
                  have "set ?DELTA2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    by simp
                  moreover
                  from c_is_c' c'_in_E2 one v'_notin_E2 νE2_empty
                  have "(β  EES2) @ [c]  EES2 @ ?DELTA2'' @ [v']  EES2 @ α2''  TrES2"
                    by (simp add: projection_def)
                  moreover
                  note two three
                  moreover
                  from νE2_empty δ1''_is_ν have "?DELTA2''  EES1 = δ1''  EES2"
                    by (simp add: projection_def)
                  ultimately show ?thesis
                    by blast
                next
                  case (Cons x xs) (* apply inductive hypothesis, then BSIA *)
                   with cδ1''_is_μc'ν have μ_is_c_xs: "μ = [c] @ xs" 
                     and δ1''_is_xs_c'_ν: "δ1'' = xs @ [c'] @ ν"
                    by auto
                  with n_is_length_μνE2 have "n = length ((c # (xs @ ν))  EES2)"
                    by auto
                  moreover
                  note Suc(3,4)
                  moreover
                  have "set ((c # (xs @ ν))  EES2)  C𝒱2  ΥΓ2"
                    proof -
                      have res: "c # (xs @ ν) = [c] @ (xs @ ν)" 
                        by auto

                      from Suc(5) cδ1''_is_μc'ν μ_is_c_xs νE2_empty
                      show ?thesis
                        by (subst res, simp only: cδ1''_is_μc'ν projection_concatenation_commute 
                          set_append, auto)
                    qed
                  moreover
                  note Suc(6) 
                  moreover
                  from Suc(7) δ1''_is_xs_c'_ν have "set (xs @ ν)  N𝒱1  ΔΓ1"
                    by auto
                  moreover note Suc(1)[of c "xs @ ν" β α2']
                  ultimately obtain δ γ
                    where one: "set δ  EES2"
                    and two: "set γ  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    and three: "β  EES2 @ [c]  EES2 @ γ @ [v']  EES2 @ δ  TrES2"
                    and four: "δ  V𝒱2 = α2'  V𝒱2"
                    and five: "δ  C𝒱2 = []"
                    and six: "γ  EES1 = (xs @ ν)  EES2"
                    by blast
                  
                   (* apply BSIA to insert c' after γ *)
                  let ?BETA = "β  EES2 @ [c]  EES2 @ γ"

                  from c'_in_Cv2_inter_Upsilon2 have "c'  C𝒱2"
                    by auto
                  moreover
                  from three v'_notin_E2 have "?BETA @ δ  TrES2"
                    by (simp add: projection_def)
                  moreover
                  note five 
                  moreover
                  have "Adm 𝒱2 ρ2 TrES2 ?BETA c'"
                    proof -
                      have "?BETA @ [c']  TrES2"
                        proof -
                          from validES2 three have "?BETA  TrES2"
                            by (simp only: ES_valid_def traces_prefixclosed_def
                              projection_concatenation_commute prefixclosed_def prefix_def, auto)
                          moreover
                          note c'_in_Cv2_inter_Upsilon2 total_ES2_C2_inter_Upsilon2
                          ultimately show ?thesis
                            unfolding total_def
                            by blast
                        qed
                      thus ?thesis
                        unfolding Adm_def
                        by blast                        
                    qed
                  moreover
                  note BSIA2
                  ultimately obtain α2''
                    where bsia_one: "?BETA @ [c'] @ α2''  TrES2"
                    and bsia_two: "α2''  V𝒱2 = δ  V𝒱2"
                    and bsia_three:  "α2''  C𝒱2 = []"
                    unfolding BSIA_def
                    by blast
  
                  let ?DELTA2'' = "γ @ [c']"

                  from bsia_one validES2 have "set α2''  EES2"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  have "set ?DELTA2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    proof -
                      from Suc(7) c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν 
                      have "c'   C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                        by auto
                      with two show ?thesis
                        by auto
                    qed
                  moreover
                  from bsia_one v'_notin_E2 
                  have "β  EES2 @ [c]  EES2 @ ?DELTA2'' @ [v']  EES2 @ α2''  TrES2"
                    by (simp add: projection_def)
                  moreover
                  from bsia_two four have "α2''  V𝒱2 = α2'  V𝒱2"
                    by simp
                  moreover
                  note bsia_three
                  moreover             
                  have "?DELTA2''  EES1 = δ1''  EES2"
                    proof -
                      from validV1 Suc(7) δ1''_is_xs_c'_ν have "c'  EES1"
                        by (simp add: isViewOn_def V_valid_def
                          VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                      with c'_in_E2 c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν νE2_empty six 
                      show ?thesis
                        by (simp only: projection_concatenation_commute 
                          projection_def, auto)
                    qed
                  ultimately show ?thesis 
                    by blast     
                qed
            qed
          from this[OF βv'E2α2'_in_Tr2 α2'Cv2_empty cδ1''E2_in_Cv2_inter_Upsilon2star 
            c_in_Cv_inter_Upsilon δ1''_in_N1_inter_Delta1star]
          show ?thesis 
            by blast
        qed
      then obtain α2'' δ2''
        where α2''_in_E2star: "set α2''  EES2"
        and δ2''_in_N2_inter_Delta2star:"set δ2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
        and βE2_cE2_δ2''_v'E2_α2''_in_Tr2: 
        "β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2"
        and α2''Vv2_is_α2'Vv2: "α2''  V𝒱2 = α2'  V𝒱2"
        and α2''Cv2_empty: "α2''  C𝒱2 = []"
        and δ2''E1_is_δ1''E2: "δ2''  EES1 = δ1''  EES2"
        by blast

      from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 βE1_cE1_δ1''_v'E1_α1''_in_Tr1 
        validES2 validES1
      have δ2''_in_E2star: "set δ2''  EES2" and δ1''_in_E1star: "set δ1''  EES1"
        by (simp_all add: ES_valid_def traces_contain_events_def, auto)
      with δ2''E1_is_δ1''E2 merge_property[of δ2'' "EES2" δ1'' "EES1"] obtain δ'
        where δ'E2_is_δ2'': "δ'  EES2 = δ2''"
        and δ'E1_is_δ1'': "δ'  EES1 = δ1''"
        and δ'_contains_only_δ2''_δ1''_events: "set δ'  set δ2''  set δ1''"
        unfolding Let_def
        by auto

      let ?TAU = "β @ [c] @ δ' @ [v']"
      let ?LAMBDA = "α  V𝒱"
      let ?T2 = α2''
      let ?T1 = α1''

     (* apply the generalized zipping lemma *)
     have "?TAU  Tr(ES1  ES2)"
        proof -
          from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 δ'E2_is_δ2'' validES2 
          have "β  EES2 @ [c]  EES2 @ δ'  EES2 @ [v']  EES2  TrES2"
            by (simp add: ES_valid_def traces_prefixclosed_def
              prefixclosed_def prefix_def)
          hence "(β @ [c] @ δ' @ [v'])  EES2  TrES2"
            by (simp add: projection_def, auto)
          moreover          
          from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 δ'E1_is_δ1'' validES1 
          have "β  EES1 @ [c]  EES1 @ δ'  EES1 @ [v']  EES1  TrES1"
            by (simp add: ES_valid_def traces_prefixclosed_def
              prefixclosed_def prefix_def)
          hence "(β @ [c] @ δ' @ [v'])  EES1  TrES1"
            by (simp add: projection_def, auto)
          moreover
          from βv'α_in_Tr c_in_Cv_inter_Upsilon VIsViewOnE δ'_contains_only_δ2''_δ1''_events 
            δ2''_in_E2star δ1''_in_E1star
          have "set (β @ [c] @ δ' @ [v'])  EES2  EES1"
            unfolding composeES_def isViewOn_def V_valid_def VC_disjoint_def 
              VN_disjoint_def NC_disjoint_def
            by auto
          ultimately show ?thesis
            unfolding composeES_def
            by auto
        qed 
      hence "set ?TAU  E(ES1  ES2)"
        unfolding composeES_def
        by auto
      moreover
      have "set ?LAMBDA  V𝒱"
        by (simp add: projection_def, auto)
      moreover
      note α2''_in_E2star α1''_in_E1star
      moreover
      from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 δ'E2_is_δ2'' 
      have "?TAU  EES2 @ ?T2  TrES2"
        by (simp only: projection_concatenation_commute, auto)
      moreover
      from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 δ'E1_is_δ1'' 
      have "?TAU  EES1 @ ?T1  TrES1"
        by (simp only: projection_concatenation_commute, auto)
      moreover
      have "?LAMBDA  EES2 = ?T2  V𝒱"
        proof -
          from propSepViews 
          have "?LAMBDA  EES2 = α  V𝒱2"
            unfolding properSeparationOfViews_def  by (simp only: projection_sequence)
          moreover
          from α2''_in_E2star propSepViews
          have "?T2  V𝒱 = ?T2  V𝒱2"
            unfolding properSeparationOfViews_def
            by (metis Int_commute projection_intersection_neutral)
          moreover
          note α2'Vv2_is_αVv2 α2''Vv2_is_α2'Vv2
          ultimately show ?thesis
            by simp
        qed
      moreover
      have "?LAMBDA  EES1 = ?T1  V𝒱"
        proof -
          from propSepViews
          have "?LAMBDA  EES1 = α  V𝒱1"
            unfolding properSeparationOfViews_def  by (simp add: projection_sequence)
          moreover
          from α1''_in_E1star propSepViews
          have "?T1  V𝒱 = ?T1  V𝒱1"
            unfolding properSeparationOfViews_def 
            by (metis Int_commute projection_intersection_neutral)
          moreover
          note α1'Vv1_is_αVv1 α1''Vv1_is_α1'Vv1
          ultimately show ?thesis
            by simp
        qed
      moreover
      note α2''Cv2_empty α1''Cv1_empty generalized_zipping_lemma
      ultimately obtain t (* show that the conclusion of FCI holds *)
        where "?TAU @ t  Tr(ES1  ES2)"
        and  "t  V𝒱 = ?LAMBDA"
        and "t  C𝒱 = []"
        by blast
      moreover
      have "set δ'  N𝒱  ΔΓ"
        proof -
          from δ'_contains_only_δ2''_δ1''_events δ2''_in_N2_inter_Delta2star
               δ1''_in_N1_inter_Delta1star
          have "set δ'  N𝒱2  ΔΓ2  N𝒱1  ΔΓ1"
            by auto
          with Delta1_N1_Delta2_N2_subset_Delta Nv1_union_Nv2_subsetof_Nv show ?thesis
            by auto
        qed
      ultimately have "α' γ'. (set γ'  N𝒱  ΔΓ  β @ [c] @ γ' @ [v'] @ α'  Tr(ES1  ES2) 
         α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])"
        by (simp only: append_assoc, blast)
    }
    ultimately have "α' γ'. (set γ'  N𝒱  ΔΓ  β @ [c] @ γ' @ [v'] @ α'  Tr(ES1  ES2) 
       α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])"
      by blast
  }
  thus ?thesis
    unfolding FCI_def
    by blast
qed


(* Theorem 6.4.1 case 6 *)
theorem compositionality_FCIA: 
  " BSD 𝒱1 TrES1; BSD 𝒱2 TrES2; BSIA ρ1 𝒱1 TrES1; BSIA ρ2 𝒱2 TrES2;
  (ρ1 𝒱1)  (ρ 𝒱)  EES1; (ρ2 𝒱2)  (ρ 𝒱)  EES2;
  total ES1 (C𝒱1  ΥΓ1  N𝒱2  ΔΓ2); total ES2 (C𝒱2  ΥΓ2  N𝒱1  ΔΓ1);Γ  EES1 Γ1;Γ  EES2 Γ2;
  ΥΓ  EES1  ΥΓ1; ΥΓ  EES2  ΥΓ2;
  ( ΔΓ1  N𝒱1  ΔΓ2  N𝒱2 )  ΔΓ;
  (N𝒱1  ΔΓ1  EES2 = {}  N𝒱2  ΔΓ2  EES1  ΥΓ1)
   ( N𝒱2  ΔΓ2  EES1 = {}  N𝒱1  ΔΓ1  EES2  ΥΓ2)  ;
  FCIA ρ1 Γ1 𝒱1 TrES1; FCIA ρ2 Γ2 𝒱2 TrES2  
   FCIA ρ Γ 𝒱 (Tr(ES1  ES2))"
proof -
 assume BSD1: "BSD 𝒱1 TrES1" 
    and BSD2: "BSD 𝒱2 TrES2"
    and BSIA1: "BSIA ρ1 𝒱1 TrES1"
    and BSIA2: "BSIA ρ2 𝒱2 TrES2"
    and ρ1v1_subset_ρv_inter_E1: "(ρ1 𝒱1)  (ρ 𝒱)  EES1"
    and ρ2v2_subset_ρv_inter_E2: "(ρ2 𝒱2)  (ρ 𝒱)  EES2"
    and total_ES1_C1_inter_Upsilon1_inter_N2_inter_Delta2: 
     "total ES1 (C𝒱1  ΥΓ1  N𝒱2  ΔΓ2)"
    and total_ES2_C2_inter_Upsilon2_inter_N1_inter_Delta1: 
     "total ES2 (C𝒱2  ΥΓ2  N𝒱1  ΔΓ1)"
    and Nabla_inter_E1_subset_Nabla1: "∇Γ  EES1 Γ1"
    and Nabla_inter_E2_subset_Nabla2: "∇Γ  EES2 Γ2"
    and Upsilon_inter_E1_subset_Upsilon1: Γ  EES1  ΥΓ1"
    and Upsilon_inter_E2_subset_Upsilon2: Γ  EES2  ΥΓ2"
    and Delta1_N1_Delta2_N2_subset_Delta: "( ΔΓ1  N𝒱1  ΔΓ2  N𝒱2 )  ΔΓ"
    and very_long_asm: "(N𝒱1  ΔΓ1  EES2 = {}  N𝒱2  ΔΓ2  EES1  ΥΓ1)
     ( N𝒱2  ΔΓ2  EES1 = {}  N𝒱1  ΔΓ1  EES2  ΥΓ2)"
    and FCIA1: "FCIA ρ1 Γ1 𝒱1 TrES1"
    and FCIA2: "FCIA ρ2 Γ2 𝒱2 TrES2"

  {
    fix α β c v'
    assume c_in_Cv_inter_Upsilon: "c  (C𝒱  ΥΓ)"
      and v'_in_Vv_inter_Nabla: "v'  (V𝒱 Γ)"
      and βv'α_in_Tr: "(β @ [v'] @ α)  Tr(ES1  ES2)" 
      and αCv_empty: "α  C𝒱 = []"
      and Adm: "Adm 𝒱 ρ (Tr(ES1  ES2)) β c"

    interpret CSES1: CompositionSupport "ES1" "𝒱" "𝒱1"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES1 validV1)

    interpret CSES2: CompositionSupport "ES2" "𝒱" "𝒱2"
      using propSepViews unfolding properSeparationOfViews_def 
      by (simp add: CompositionSupport_def validES2 validV2)

    from  βv'α_in_Tr
    have  βv'α_E1_in_Tr1: "(((β @ [v']) @ α)  EES1)  TrES1"
      and βv'α_E2_in_Tr2: "(((β @ [v']) @ α)  EES2)  TrES2"
      by (simp add: composeES_def)+    

    from CSES1.BSD_in_subsystem2[OF βv'α_E1_in_Tr1 BSD1] obtain α1'
      where βv'E1α1'_in_Tr1: "(β @ [v'])  EES1 @ α1'  TrES1"
      and α1'Vv1_is_αVv1: "α1'  V𝒱1 = α  V𝒱1"
      and α1'Cv1_empty: "α1'  C𝒱1 = []"
      by auto

    from CSES2.BSD_in_subsystem2[OF βv'α_E2_in_Tr2 BSD2] obtain α2'
      where βv'E2α2'_in_Tr2: "(β @ [v'])  EES2 @ α2'  TrES2"
      and α2'Vv2_is_αVv2: "α2'  V𝒱2 = α  V𝒱2"
      and α2'Cv2_empty: "α2'  C𝒱2 = []"
      by auto

    note very_long_asm
    moreover {
      assume Nv1_inter_Delta1_inter_E2_empty: "N𝒱1  ΔΓ1  EES2 = {}" 
        and  Nv2_inter_Delta2_inter_E1_subsetof_Upsilon1: "N𝒱2  ΔΓ2  EES1  ΥΓ1"

      let ?ALPHA2''_DELTA2'' = " α2'' δ2''. (
        set α2''  EES2  set δ2''  N𝒱2  ΔΓ2 
         β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2        
         α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = [])"

      from c_in_Cv_inter_Upsilon v'_in_Vv_inter_Nabla validV2
      have "c  EES2  (c  EES2  v'  EES2)  (c  EES2  v'  EES2)"
        by (simp add: V_valid_def isViewOn_def 
          VC_disjoint_def VN_disjoint_def NC_disjoint_def)
      moreover {
        assume c_notin_E2: "c  EES2"

        from validES2 βv'E2α2'_in_Tr2 have "set α2'  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover 
        have "set []  N𝒱2  ΔΓ2"
          by auto
        moreover 
        from βv'E2α2'_in_Tr2 c_notin_E2 
        have "β  EES2 @ [c]  EES2 @ [] @ [v']  EES2 @ α2'  TrES2"
          by (simp add: projection_def)
        moreover
        have "α2'  V𝒱2 = α2'  V𝒱2" ..
        moreover 
        note α2'Cv2_empty
        ultimately have ?ALPHA2''_DELTA2''
          by blast
      }
      moreover {
        assume c_in_E2: "c  EES2"
          and  v'_notin_E2: "v'  EES2"

        from c_in_E2 c_in_Cv_inter_Upsilon propSepViews
          Upsilon_inter_E2_subset_Upsilon2
        have c_in_Cv2_inter_Upsilon2: "c  C𝒱2  ΥΓ2"
          unfolding properSeparationOfViews_def by auto
        hence "c  C𝒱2"
          by auto
        moreover
        from βv'E2α2'_in_Tr2 v'_notin_E2 have "β  EES2 @ α2'  TrES2"
          by (simp add: projection_def)
        moreover
        note α2'Cv2_empty
        moreover
        have "Adm 𝒱2 ρ2 TrES2 (β  EES2) c"
        proof -
          from Adm obtain γ
            where γρv_is_βρv: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
            and γc_in_Tr: "(γ @ [c])  Tr(ES1  ES2)"
            unfolding Adm_def
            by auto

          from c_in_E2 γc_in_Tr have "(γ  EES2) @ [c]  TrES2"
            by (simp add: projection_def composeES_def)
          moreover
          have "γ  EES2  (ρ2 𝒱2) = β  EES2  (ρ2 𝒱2)"
          proof -
            from γρv_is_βρv have "γ  EES2  (ρ 𝒱) = β  EES2  (ρ 𝒱)"
              by (metis projection_commute)
            with ρ2v2_subset_ρv_inter_E2 have "γ  (ρ2 𝒱2) = β  (ρ2 𝒱2)"
              by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
            thus ?thesis
              by (metis projection_commute)
          qed
          ultimately show ?thesis unfolding Adm_def
            by auto
        qed  
        moreover 
        note BSIA2
        ultimately obtain  α2''
          where one: "β  EES2 @ [c] @ α2''  TrES2"
          and two:   "α2''  V𝒱2 = α2'  V𝒱2"
          and three: "α2''  C𝒱2 = []"
          unfolding BSIA_def
          by blast

        from one validES2 have "set α2''  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        have "set []  N𝒱2  ΔΓ2"
          by auto
        moreover
        from one c_in_E2 v'_notin_E2 
        have "β  EES2 @ [c]  EES2 @ [] @ [v']  EES2 @ α2''  TrES2"
          by (simp add: projection_def)
        moreover 
        note two three
        ultimately have ?ALPHA2''_DELTA2''
          by blast
      }
      moreover {
        assume c_in_E2: "c  EES2"
          and  v'_in_E2: "v'  EES2"

        from c_in_E2 c_in_Cv_inter_Upsilon propSepViews
          Upsilon_inter_E2_subset_Upsilon2
        have c_in_Cv2_inter_Upsilon2: "c  C𝒱2  ΥΓ2"
          unfolding properSeparationOfViews_def by auto
        moreover
        from v'_in_E2 propSepViews v'_in_Vv_inter_Nabla Nabla_inter_E2_subset_Nabla2
        have "v'  V𝒱2  Nabla Γ2"
          unfolding properSeparationOfViews_def by auto
        moreover
        from v'_in_E2  βv'E2α2'_in_Tr2 have "β  EES2 @ [v'] @ α2'  TrES2"
          by (simp add: projection_def)
        moreover
        note α2'Cv2_empty 
        moreover
        have "Adm 𝒱2 ρ2 TrES2 (β  EES2) c"
        proof -
          from Adm obtain γ
            where γρv_is_βρv: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
            and γc_in_Tr: "(γ @ [c])  Tr(ES1  ES2)"
            unfolding Adm_def
            by auto

          from c_in_E2 γc_in_Tr have "(γ  EES2) @ [c]  TrES2"
            by (simp add: projection_def composeES_def)
          moreover
          have "γ  EES2  (ρ2 𝒱2) = β  EES2  (ρ2 𝒱2)"
          proof -
            from γρv_is_βρv have "γ  EES2  (ρ 𝒱) = β  EES2  (ρ 𝒱)"
              by (metis projection_commute)
            with ρ2v2_subset_ρv_inter_E2 have "γ  (ρ2 𝒱2) = β  (ρ2 𝒱2)"
              by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
            thus ?thesis
              by (metis projection_commute)
          qed
          ultimately show ?thesis unfolding Adm_def
            by auto
        qed  
        moreover
        note FCIA2
        ultimately obtain α2'' δ2''
          where one: "set δ2''  N𝒱2  ΔΓ2"
          and two: "β  EES2 @ [c] @ δ2'' @ [v'] @ α2''  TrES2"
          and three: "α2''  V𝒱2 = α2'  V𝒱2"
          and four: "α2''  C𝒱2 = []"
          unfolding FCIA_def
          by blast

        from two validES2 have "set α2''  EES2"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        note one
        moreover
        from two c_in_E2 v'_in_E2 
        have "β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2"
          by (simp add: projection_def)
        moreover
        note three four
        ultimately have ?ALPHA2''_DELTA2''
          by blast
      }
      ultimately obtain α2'' δ2''
        where α2''_in_E2star: "set α2''  EES2"
        and δ2''_in_N2_inter_Delta2star:"set δ2''  N𝒱2  ΔΓ2"
        and βE2_cE2_δ2''_v'E2_α2''_in_Tr2:
              "β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2"
        and α2''Vv2_is_α2'Vv2: "α2''  V𝒱2 = α2'  V𝒱2"
        and α2''Cv2_empty: "α2''  C𝒱2 = []"
        by blast

      from c_in_Cv_inter_Upsilon Upsilon_inter_E1_subset_Upsilon1 propSepViews
      have cE1_in_Cv1_inter_Upsilon1: "set ([c]  EES1)  C𝒱1  ΥΓ1"
        unfolding properSeparationOfViews_def by (simp add: projection_def, auto)
     
      from δ2''_in_N2_inter_Delta2star Nv2_inter_Delta2_inter_E1_subsetof_Upsilon1 
       propSepViews disjoint_Nv2_Vv1 
      have δ2''E1_in_Cv1_inter_Upsilon1star: "set (δ2''  EES1)  C𝒱1  ΥΓ1"
        proof -
          from δ2''_in_N2_inter_Delta2star
          have eq: "δ2''  EES1 = δ2''  (N𝒱2  ΔΓ2  EES1)"
            by (metis Int_commute Int_left_commute Int_lower1 Int_lower2 
              projection_intersection_neutral subset_trans)
          
          from validV1 Nv2_inter_Delta2_inter_E1_subsetof_Upsilon1 
            propSepViews disjoint_Nv2_Vv1  
          have "N𝒱2  ΔΓ2  EES1  C𝒱1  ΥΓ1"
            unfolding properSeparationOfViews_def 
            by (simp add: isViewOn_def V_valid_def 
              VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
          thus ?thesis
            by (subst eq, simp only: projection_def, auto)
        qed
      
      have cδ2''E1_in_Cv1_inter_Upsilon1star: "set ((c # δ2'')  EES1)  C𝒱1  ΥΓ1"
        proof -
          from cE1_in_Cv1_inter_Upsilon1 δ2''E1_in_Cv1_inter_Upsilon1star
          have "set (([c] @ δ2'')  EES1)  C𝒱1  ΥΓ1"
            by (simp only: projection_concatenation_commute, auto)
          thus ?thesis
            by auto
        qed


        have 
        " α1'' δ1''. set α1''  EES1  set δ1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2        
         β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1        
         α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []
         δ1''  EES2 = δ2''  EES1"
        proof cases
          assume v'_in_E1: "v'  EES1"
          with Nabla_inter_E1_subset_Nabla1 propSepViews v'_in_Vv_inter_Nabla
          have v'_in_Vv1_inter_Nabla1: "v'  V𝒱1  Nabla Γ1"
            unfolding properSeparationOfViews_def by auto

          have " (β @ [v'])  EES1 @ α1'  TrES1 ; 
            α1'  C𝒱1 = []; set ((c # δ2'')  EES1)  C𝒱1  ΥΓ1 ; 
            c  C𝒱  ΥΓ ; set δ2''  N𝒱2  ΔΓ2;
            Adm 𝒱 ρ (Tr(ES1  ES2)) β c  
              α1'' δ1''.
            (set α1''  EES1  set δ1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2            
             β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1            
             α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []
             δ1''  (C𝒱1  ΥΓ1) = δ2''  EES1)"
            proof (induct "length ((c # δ2'')  EES1)" arbitrary: β α1' c δ2'')
              case 0

              from 0(2) validES1 have "set α1'  EES1"
                by (simp add: ES_valid_def traces_contain_events_def, auto)
              moreover
              have "set []  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                by auto
              moreover
              have "β  EES1 @ [c]  EES1 @ [] @ [v']  EES1 @ α1'  TrES1"
                proof -
                  note 0(2)
                  moreover
                  from 0(1) have "c  EES1"
                    by (simp add: projection_def, auto)
                  ultimately show ?thesis
                    by (simp add: projection_concatenation_commute projection_def)
                qed
              moreover
              have "α1'  V𝒱1 = α1'  V𝒱1" ..
              moreover
              note 0(3)
              moreover 
              from 0(1) have "[]  (C𝒱1  ΥΓ1) = δ2''  EES1"
                by (simp add: projection_def, split if_split_asm, auto)
              ultimately show ?case
                by blast
            next
              case (Suc n)

              from projection_split_last[OF Suc(2)] obtain μ c' ν
                where c'_in_E1: "c'  EES1"
                and cδ2''_is_μc'ν: "c # δ2'' = μ @ [c'] @ ν"
                and νE1_empty: "ν  EES1 = []"
                and n_is_length_μνE1: "n = length ((μ @ ν)  EES1)"
                by blast

              from Suc(5) c'_in_E1 cδ2''_is_μc'ν have "set (μ  EES1 @ [c'])  C𝒱1  ΥΓ1"
                by (simp only: cδ2''_is_μc'ν projection_concatenation_commute 
                  projection_def, auto)
              hence c'_in_Cv1_inter_Upsilon1: "c'  C𝒱1  ΥΓ1"
                by auto
              hence c'_in_Cv1: "c'  C𝒱1" and c'_in_Upsilon1: "c'  ΥΓ1"
                by auto
              with validV1 have c'_in_E1: "c'  EES1"
                by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
                  VN_disjoint_def NC_disjoint_def, auto)

              show ?case
                proof (cases μ)
                  case Nil (* we apply FCIA in this case *)
                  with cδ2''_is_μc'ν have c_is_c': "c = c'" and δ2''_is_ν: "δ2'' = ν"
                    by auto
                  with c'_in_Cv1_inter_Upsilon1 have "c  C𝒱1  ΥΓ1"
                    by simp
                  moreover
                  note v'_in_Vv1_inter_Nabla1
                  moreover
                  from v'_in_E1 Suc(3) have "(β  EES1) @ [v'] @ α1'  TrES1"
                    by (simp add: projection_concatenation_commute projection_def)
                  moreover
                  note Suc(4)
                  moreover
                  have "Adm 𝒱1 ρ1 TrES1 (β  EES1) c"
                    proof -
                      from Suc(8) obtain γ
                        where γρv_is_βρv: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
                        and γc_in_Tr: "(γ @ [c])  Tr(ES1  ES2)"
                        unfolding Adm_def
                        by auto

                      from c_is_c' c'_in_E1 γc_in_Tr have "(γ  EES1) @ [c]  TrES1"
                        by (simp add: projection_def composeES_def)
                      moreover
                      have "γ  EES1  (ρ1 𝒱1) = β  EES1  (ρ1 𝒱1)"
                      proof -
                        from γρv_is_βρv have "γ  EES1  (ρ 𝒱) = β  EES1  (ρ 𝒱)"
                          by (metis projection_commute)
                        with ρ1v1_subset_ρv_inter_E1 have "γ  (ρ1 𝒱1) = β  (ρ1 𝒱1)"
                          by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
                        thus ?thesis
                          by (metis projection_commute)
                      qed
                      ultimately show ?thesis unfolding Adm_def
                        by auto
                    qed  
                  moreover
                  note FCIA1
                  ultimately obtain α1'' γ
                    where one: "set γ  N𝒱1  ΔΓ1"
                    and two: "β  EES1 @ [c] @ γ @ [v'] @ α1''  TrES1"
                    and three: "α1''  V𝒱1 = α1'  V𝒱1"
                    and four: "α1''  C𝒱1 = []"
                    unfolding FCIA_def
                    by blast

                  (* we choose δ1'' = ν ↿ EES1 @ γ *)
                  let ?DELTA1'' = "ν  EES1 @ γ" 
                    
                  from two validES1 have "set α1''  EES1"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  from one νE1_empty
                  have "set ?DELTA1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    by auto
                  moreover
                  have "β  EES1 @ [c]  EES1 @ ?DELTA1'' @ [v']  EES1 @ α1''  TrES1"
                    proof -
                      from c_is_c' c'_in_E1 have "[c] = [c]  EES1"
                        by (simp add: projection_def)
                      moreover
                      from v'_in_E1 have "[v'] = [v']  EES1"
                        by (simp add: projection_def)
                      moreover
                      note νE1_empty two
                      ultimately show ?thesis
                        by auto
                    qed
                  moreover
                  note three four
                  moreover
                  have "?DELTA1''  (C𝒱1  ΥΓ1) = δ2''  EES1"
                    proof -
                      have "γ  (C𝒱1  ΥΓ1) = []"
                        proof -
                          from validV1 have "N𝒱1  ΔΓ1  (C𝒱1  ΥΓ1) = {}"
                            by (simp add: isViewOn_def V_valid_def
                              VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                          with projection_intersection_neutral[OF one, of "C𝒱1  ΥΓ1"]
                          show ?thesis
                            by (simp add: projection_def)
                        qed
                      with δ2''_is_ν νE1_empty show ?thesis
                        by (simp add: projection_concatenation_commute)
                    qed
                  ultimately show ?thesis
                    by blast
                next
                  case (Cons x xs) (* we apply the inductive hypothesis in this case *)
                  with cδ2''_is_μc'ν
                  have μ_is_c_xs: "μ = [c] @ xs" and δ2''_is_xs_c'_ν: "δ2'' = xs @ [c'] @ ν"
                    by auto
                  with n_is_length_μνE1 have "n = length ((c # (xs @ ν))  EES1)"
                    by auto
                  moreover
                  note Suc(3,4)
                  moreover
                  have "set ((c # (xs @ ν))  EES1)  C𝒱1  ΥΓ1"
                    proof -
                      have res: "c # (xs @ ν) = [c] @ (xs @ ν)" 
                        by auto

                      from Suc(5) cδ2''_is_μc'ν μ_is_c_xs νE1_empty
                      show ?thesis
                        by (subst res, simp only: cδ2''_is_μc'ν 
                          projection_concatenation_commute set_append, auto)
                    qed
                  moreover
                  note Suc(6) 
                  moreover
                  from Suc(7) δ2''_is_xs_c'_ν have "set (xs @ ν)  N𝒱2  ΔΓ2"
                    by auto
                  moreover note Suc(8) Suc(1)[of c "xs @ ν" β α1']
                  ultimately obtain δ γ
                    where one: "set δ  EES1"
                    and two: "set γ  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    and three: "β  EES1 @ [c]  EES1 @ γ @ [v']  EES1 @ δ  TrES1"
                    and four: "δ  V𝒱1 = α1'  V𝒱1"
                    and five: "δ  C𝒱1 = []"
                    and six: "γ  (C𝒱1  ΥΓ1) = (xs @ ν)  EES1"
                    by blast

                  (* apply FCIA to insert c' after γ *)
                  let ?BETA = "β  EES1 @ [c]  EES1 @ γ"

                  note c'_in_Cv1_inter_Upsilon1 v'_in_Vv1_inter_Nabla1
                  moreover
                  from three v'_in_E1 have "?BETA @ [v'] @ δ  TrES1"
                    by (simp add: projection_def)
                  moreover
                  note five 
                  moreover
                  have "Adm 𝒱1 ρ1 TrES1 ?BETA c'"
                    proof -
                      have "?BETA @ [c']  TrES1"
                        proof -
                          from Suc(7) c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν
                          have "c'  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                            by auto
                          moreover
                          from validES1 three have "?BETA  TrES1"
                            by (unfold ES_valid_def traces_prefixclosed_def
                              prefixclosed_def prefix_def, auto)
                          moreover
                          note total_ES1_C1_inter_Upsilon1_inter_N2_inter_Delta2
                          ultimately show ?thesis
                            unfolding total_def
                            by blast
                        qed
                      thus ?thesis
                        unfolding Adm_def
                        by blast                        
                    qed
                  moreover
                  note FCIA1
                  ultimately obtain α1'' δ'
                    where fcia_one: "set δ'  N𝒱1  ΔΓ1"
                    and fcia_two: "?BETA @ [c'] @ δ' @ [v'] @ α1''  TrES1"
                    and fcia_three: "α1''  V𝒱1 = δ  V𝒱1"
                    and fcia_four:  "α1''  C𝒱1 = []"
                    unfolding FCIA_def
                    by blast
  
                  let ?DELTA1'' = "γ @ [c'] @ δ'"

                  from fcia_two validES1 have "set α1''  EES1"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  have "set ?DELTA1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    proof -
                      from Suc(7) c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν 
                      have "c'   C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                        by auto
                      with two fcia_one show ?thesis
                        by auto
                    qed
                  moreover
                  from fcia_two v'_in_E1 
                  have "β  EES1 @ [c]  EES1 @ ?DELTA1'' @ [v']  EES1 @ α1''  TrES1"
                    by (simp add: projection_def)
                  moreover
                  from fcia_three four have "α1''  V𝒱1 = α1'  V𝒱1"
                    by simp
                  moreover
                  note fcia_four
                  moreover             
                  have "?DELTA1''  (C𝒱1  ΥΓ1) = δ2''  EES1"
                    proof -
                      have "δ'  (C𝒱1  ΥΓ1) = []"
                        proof -
                          from fcia_one have " e  set δ'. e  N𝒱1  ΔΓ1"
                            by auto
                          with validV1 have " e  set δ'. e  C𝒱1  ΥΓ1"
                            by (simp add: isViewOn_def V_valid_def 
                              VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                          thus ?thesis
                            by (simp add: projection_def)
                        qed
                      with c'_in_E1 c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν νE1_empty six 
                      show ?thesis
                        by (simp only: projection_concatenation_commute projection_def, auto)
                    qed
                  ultimately show ?thesis 
                    by blast     
                qed
          qed
          from this[OF βv'E1α1'_in_Tr1 α1'Cv1_empty cδ2''E1_in_Cv1_inter_Upsilon1star 
            c_in_Cv_inter_Upsilon δ2''_in_N2_inter_Delta2star Adm]
          obtain α1'' δ1''
            where one: "set α1''  EES1"
            and two: "set δ1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
            and three: "β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1            
             α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []"
            and four: "δ1''  (C𝒱1  ΥΓ1) = δ2''  EES1"
            by blast

          note one two three
          moreover
          have "δ1''  EES2 = δ2''  EES1" 
            proof -
              from projection_intersection_neutral[OF two, of "EES2"] 
                Nv1_inter_Delta1_inter_E2_empty validV2 
              have "δ1''  EES2 = δ1''  (C𝒱1  ΥΓ1  N𝒱2  ΔΓ2  EES2)"
                by (simp only: Int_Un_distrib2, auto)
              moreover
              from validV2 
              have "C𝒱1  ΥΓ1  N𝒱2  ΔΓ2  EES2 = C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                by (simp add:isViewOn_def  V_valid_def  VC_disjoint_def 
                  VN_disjoint_def NC_disjoint_def, auto)
              ultimately have "δ1''  EES2 = δ1''  (C𝒱1  ΥΓ1  N𝒱2  ΔΓ2)"
                by simp
              hence "δ1''  EES2 = δ1''  (C𝒱1  ΥΓ1)  (N𝒱2  ΔΓ2)"
                by (simp add: projection_def)
              with four have "δ1''  EES2 = δ2''  EES1  (N𝒱2  ΔΓ2)"
                by simp
              hence "δ1''  EES2 = δ2''  (N𝒱2  ΔΓ2)  EES1"
                by (simp only: projection_commute)
              with δ2''_in_N2_inter_Delta2star show ?thesis
                by (simp only: list_subset_iff_projection_neutral)
            qed
          ultimately show ?thesis
              by blast
        next
          assume v'_notin_E1: "v'  EES1"

           have " (β @ [v'])  EES1 @ α1'  TrES1 ; 
            α1'  C𝒱1 = []; set ((c # δ2'')  EES1)  C𝒱1  ΥΓ1 ; 
             c  C𝒱  ΥΓ ; set δ2''  N𝒱2  ΔΓ2;
            Adm 𝒱 ρ (Tr(ES1  ES2)) β c  
              α1'' δ1''. (set α1''  EES1  set δ1''  N𝒱1 
              ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2            
              β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1            
              α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = []
             δ1''  EES2 = δ2''  EES1)"
            proof (induct "length ((c # δ2'')  EES1)" arbitrary: β α1' c δ2'')
               case 0

              from 0(2) validES1 have "set α1'  EES1"
                by (simp add: ES_valid_def traces_contain_events_def, auto)
              moreover
              have "set []  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                by auto
              moreover
              have "β  EES1 @ [c]  EES1 @ [] @ [v']  EES1 @ α1'  TrES1"
                proof -
                  note 0(2)
                  moreover
                  from 0(1) have "c  EES1"
                    by (simp add: projection_def, auto)
                  ultimately show ?thesis
                    by (simp add: projection_concatenation_commute projection_def)
                qed
              moreover
              have "α1'  V𝒱1 = α1'  V𝒱1" ..
              moreover
              note 0(3)
              moreover 
              from 0(1) have "[]  EES2 = δ2''  EES1"
                by (simp add: projection_def, split if_split_asm, auto)
              ultimately show ?case
                by blast
            next
              case (Suc n)

              from projection_split_last[OF Suc(2)] obtain μ c' ν
                where c'_in_E1: "c'  EES1"
                and cδ2''_is_μc'ν: "c # δ2'' = μ @ [c'] @ ν"
                and νE1_empty: "ν  EES1 = []"
                and n_is_length_μνE1: "n = length ((μ @ ν)  EES1)"
                by blast

              from Suc(5) c'_in_E1 cδ2''_is_μc'ν have "set (μ  EES1 @ [c'])  C𝒱1  ΥΓ1"
                by (simp only: cδ2''_is_μc'ν projection_concatenation_commute projection_def, auto)
              hence c'_in_Cv1_inter_Upsilon1: "c'  C𝒱1  ΥΓ1"
                by auto
              hence c'_in_Cv1: "c'  C𝒱1" and c'_in_Upsilon1: "c'  ΥΓ1"
                by auto
              with validV1 have c'_in_E1: "c'  EES1"
                by (simp add:isViewOn_def V_valid_def VC_disjoint_def 
                  VN_disjoint_def NC_disjoint_def, auto)

              show ?case
                proof (cases μ)
                  case Nil (* we just apply BSIA in this case *)
                  with cδ2''_is_μc'ν have c_is_c': "c = c'" and δ2''_is_ν: "δ2'' = ν"
                    by auto
                  with c'_in_Cv1_inter_Upsilon1 have "c  C𝒱1"
                    by simp
                  moreover
                  from v'_notin_E1 Suc(3) have "(β  EES1) @ α1'  TrES1"
                    by (simp add: projection_concatenation_commute projection_def)
                  moreover
                  note Suc(4)
                  moreover
                  have "Adm 𝒱1 ρ1 TrES1 (β  EES1) c"
                     proof -
                      from Suc(8) obtain γ
                        where γρv_is_βρv: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
                        and γc_in_Tr: "(γ @ [c])  Tr(ES1  ES2)"
                        unfolding Adm_def
                        by auto

                      from c_is_c' c'_in_E1 γc_in_Tr have "(γ  EES1) @ [c]  TrES1"
                        by (simp add: projection_def composeES_def)
                      moreover
                      have "γ  EES1  (ρ1 𝒱1) = β  EES1  (ρ1 𝒱1)"
                      proof -
                        from γρv_is_βρv have "γ  EES1  (ρ 𝒱) = β  EES1  (ρ 𝒱)"
                          by (metis projection_commute)
                        with ρ1v1_subset_ρv_inter_E1 have "γ  (ρ1 𝒱1) = β  (ρ1 𝒱1)"
                          by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
                        thus ?thesis
                          by (metis projection_commute)
                      qed
                      ultimately show ?thesis unfolding Adm_def
                        by auto
                    qed  
                  moreover
                  note BSIA1
                  ultimately obtain α1''
                    where one: "(β  EES1) @ [c] @ α1''  TrES1"
                    and two: "α1''  V𝒱1 = α1'  V𝒱1"
                    and three: "α1''  C𝒱1 = []"
                    unfolding BSIA_def
                    by blast

                  let ?DELTA1'' = "ν  EES1"

                  from one validES1 have "set α1''  EES1"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  from νE1_empty
                  have "set ?DELTA1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    by simp
                  moreover
                  from c_is_c' c'_in_E1 one v'_notin_E1 νE1_empty
                  have "(β  EES1) @ [c]  EES1 @ ?DELTA1'' @ [v']  EES1 @ α1''  TrES1"
                    by (simp add: projection_def)
                  moreover
                  note two three
                  moreover
                  from νE1_empty δ2''_is_ν have "?DELTA1''  EES2 = δ2''  EES1"
                    by (simp add: projection_def)
                  ultimately show ?thesis
                    by blast
                next
                  case (Cons x xs) (* apply inductive hypothesis, then BSIA *)
                  with cδ2''_is_μc'ν
                  have μ_is_c_xs: "μ = [c] @ xs" and δ2''_is_xs_c'_ν: "δ2'' = xs @ [c'] @ ν"
                    by auto
                  with n_is_length_μνE1 have "n = length ((c # (xs @ ν))  EES1)"
                    by auto
                  moreover
                  note Suc(3,4)
                  moreover
                  have "set ((c # (xs @ ν))  EES1)  C𝒱1  ΥΓ1"
                    proof -
                      have res: "c # (xs @ ν) = [c] @ (xs @ ν)" 
                        by auto

                      from Suc(5) cδ2''_is_μc'ν μ_is_c_xs νE1_empty
                      show ?thesis
                        by (subst res, simp only: cδ2''_is_μc'ν projection_concatenation_commute 
                          set_append, auto)
                    qed
                  moreover
                  note Suc(6) 
                  moreover
                  from Suc(7) δ2''_is_xs_c'_ν have "set (xs @ ν)  N𝒱2  ΔΓ2"
                    by auto
                  moreover note Suc(8) Suc(1)[of c "xs @ ν" β α1']
                  ultimately obtain δ γ
                    where one: "set δ  EES1"
                    and two: "set γ  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    and three: "β  EES1 @ [c]  EES1 @ γ @ [v']  EES1 @ δ  TrES1"
                    and four: "δ  V𝒱1 = α1'  V𝒱1"
                    and five: "δ  C𝒱1 = []"
                    and six: "γ  EES2 = (xs @ ν)  EES1"
                    by blast
                  
                   (* apply BSIA to insert c' after γ *)
                  let ?BETA = "β  EES1 @ [c]  EES1 @ γ"

                  from c'_in_Cv1_inter_Upsilon1 have "c'  C𝒱1"
                    by auto
                  moreover
                  from three v'_notin_E1 have "?BETA @ δ  TrES1"
                    by (simp add: projection_def)
                  moreover
                  note five 
                  moreover
                  have "Adm 𝒱1 ρ1 TrES1 ?BETA c'"
                    proof -
                      have "?BETA @ [c']  TrES1"
                        proof -
                          from Suc(7) c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν
                          have "c'  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                            by auto
                          moreover
                          from validES1 three have "?BETA  TrES1"
                            by (unfold ES_valid_def traces_prefixclosed_def
                              prefixclosed_def prefix_def, auto)
                          moreover
                          note total_ES1_C1_inter_Upsilon1_inter_N2_inter_Delta2
                          ultimately show ?thesis
                            unfolding total_def
                            by blast
                        qed
                      thus ?thesis
                        unfolding Adm_def
                        by blast                      
                    qed
                  moreover
                  note BSIA1
                  ultimately obtain α1''
                    where bsia_one: "?BETA @ [c'] @ α1''  TrES1"
                    and bsia_two: "α1''  V𝒱1 = δ  V𝒱1"
                    and bsia_three:  "α1''  C𝒱1 = []"
                    unfolding BSIA_def
                    by blast
  
                  let ?DELTA1'' = "γ @ [c']"

                  from bsia_one validES1 have "set α1''  EES1"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  have "set ?DELTA1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                    proof -
                      from Suc(7) c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν 
                      have "c'   C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
                        by auto
                      with two show ?thesis
                        by auto
                    qed
                  moreover
                  from bsia_one v'_notin_E1 
                  have "β  EES1 @ [c]  EES1 @ ?DELTA1'' @ [v']  EES1 @ α1''  TrES1"
                    by (simp add: projection_def)
                  moreover
                  from bsia_two four have "α1''  V𝒱1 = α1'  V𝒱1"
                    by simp
                  moreover
                  note bsia_three
                  moreover             
                  have "?DELTA1''  EES2 = δ2''  EES1"
                    proof -
                      from validV2 Suc(7) δ2''_is_xs_c'_ν have "c'  EES2"
                        by (simp add: isViewOn_def V_valid_def
                          VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                      with c'_in_E1 c'_in_Cv1_inter_Upsilon1 δ2''_is_xs_c'_ν νE1_empty six 
                      show ?thesis
                        by (simp only: projection_concatenation_commute projection_def, auto)
                    qed
                  ultimately show ?thesis 
                    by blast     
                qed
            qed
          from this[OF βv'E1α1'_in_Tr1 α1'Cv1_empty cδ2''E1_in_Cv1_inter_Upsilon1star 
            c_in_Cv_inter_Upsilon δ2''_in_N2_inter_Delta2star Adm]
          show ?thesis 
            by blast
        qed
      then obtain α1'' δ1''
        where α1''_in_E1star: "set α1''  EES1"
        and δ1''_in_N1_inter_Delta1star:"set δ1''  N𝒱1  ΔΓ1  C𝒱1  ΥΓ1  N𝒱2  ΔΓ2"
        and βE1_cE1_δ1''_v'E1_α1''_in_Tr1: 
          "β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1"
        and α1''Vv1_is_α1'Vv1: "α1''  V𝒱1 = α1'  V𝒱1"
        and α1''Cv1_empty: "α1''  C𝒱1 = []"
        and δ1''E2_is_δ2''E1: "δ1''  EES2 = δ2''  EES1"
        by blast

      from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 βE2_cE2_δ2''_v'E2_α2''_in_Tr2 validES1 
        validES2
      have δ1''_in_E1star: "set δ1''  EES1" and δ2''_in_E2star: "set δ2''  EES2"
        by (simp_all add: ES_valid_def traces_contain_events_def, auto)
      with δ1''E2_is_δ2''E1 merge_property[of δ1'' "EES1" δ2'' "EES2"] obtain δ'
        where δ'E1_is_δ1'': "δ'  EES1 = δ1''"
        and δ'E2_is_δ2'': "δ'  EES2 = δ2''"
        and δ'_contains_only_δ1''_δ2''_events: "set δ'  set δ1''  set δ2''"
        unfolding Let_def
        by auto

      let ?TAU = "β @ [c] @ δ' @ [v']"
      let ?LAMBDA = "α  V𝒱"
      let ?T1 = α1''
      let ?T2 = α2''

     (* apply the generalized zipping lemma *)
     have "?TAU  Tr(ES1  ES2)"
        proof -
          from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 δ'E1_is_δ1'' validES1
          have "β  EES1 @ [c]  EES1 @ δ'  EES1 @ [v']  EES1  TrES1"
            by (simp add: ES_valid_def traces_prefixclosed_def
              prefixclosed_def prefix_def)
          hence "(β @ [c] @ δ' @ [v'])  EES1  TrES1"
            by (simp add: projection_def, auto)
          moreover          
          from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 δ'E2_is_δ2'' validES2 
          have "β  EES2 @ [c]  EES2 @ δ'  EES2 @ [v']  EES2  TrES2"
            by (simp add: ES_valid_def traces_prefixclosed_def
              prefixclosed_def prefix_def)
          hence "(β @ [c] @ δ' @ [v'])  EES2  TrES2"
            by (simp add: projection_def, auto)
          moreover
          from βv'α_in_Tr c_in_Cv_inter_Upsilon VIsViewOnE δ'_contains_only_δ1''_δ2''_events 
            δ1''_in_E1star δ2''_in_E2star
          have "set (β @ [c] @ δ' @ [v'])  EES1  EES2"
            unfolding composeES_def isViewOn_def V_valid_def 
              VC_disjoint_def VN_disjoint_def NC_disjoint_def
            by auto
          ultimately show ?thesis
            unfolding composeES_def
            by auto
        qed 
      hence "set ?TAU  E(ES1  ES2)"
        unfolding composeES_def
        by auto
      moreover
      have "set ?LAMBDA  V𝒱"
        by (simp add: projection_def, auto)
      moreover
      note α1''_in_E1star α2''_in_E2star
      moreover
      from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 δ'E1_is_δ1'' 
      have "?TAU  EES1 @ ?T1  TrES1"
        by (simp only: projection_concatenation_commute, auto)
      moreover
      from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 δ'E2_is_δ2'' 
      have "?TAU  EES2 @ ?T2  TrES2"
        by (simp only: projection_concatenation_commute, auto)
      moreover
      have "?LAMBDA  EES1 = ?T1  V𝒱"
        proof -
          from propSepViews have "?LAMBDA  EES1 = α  V𝒱1"
            unfolding properSeparationOfViews_def by (simp only: projection_sequence)
          moreover
          from α1''_in_E1star propSepViews 
          have "?T1  V𝒱 = ?T1  V𝒱1"
            unfolding properSeparationOfViews_def
            by (metis Int_commute projection_intersection_neutral)
          moreover
          note α1'Vv1_is_αVv1 α1''Vv1_is_α1'Vv1
          ultimately show ?thesis
            by simp
        qed
      moreover
      have "?LAMBDA  EES2 = ?T2  V𝒱"
        proof -
          from propSepViews have "?LAMBDA  EES2 = α  V𝒱2"
            unfolding properSeparationOfViews_def by (simp only: projection_sequence)
          moreover
          from α2''_in_E2star propSepViews have "?T2  V𝒱 = ?T2  V𝒱2"
            unfolding properSeparationOfViews_def
            by (metis Int_commute projection_intersection_neutral)
          moreover
          note α2'Vv2_is_αVv2 α2''Vv2_is_α2'Vv2
          ultimately show ?thesis
            by simp
        qed
      moreover
      note α1''Cv1_empty α2''Cv2_empty generalized_zipping_lemma
      ultimately obtain t (* show that the conclusion of FCIA holds *)
        where "?TAU @ t  Tr(ES1  ES2)"
        and  "t  V𝒱 = ?LAMBDA"
        and "t  C𝒱 = []"
        by blast
      moreover
      have "set δ'  N𝒱  ΔΓ"
        proof -
          from δ'_contains_only_δ1''_δ2''_events δ1''_in_N1_inter_Delta1star 
            δ2''_in_N2_inter_Delta2star
          have "set δ'  N𝒱1  ΔΓ1  N𝒱2  ΔΓ2"
            by auto
          with Delta1_N1_Delta2_N2_subset_Delta Nv1_union_Nv2_subsetof_Nv 
          show ?thesis
            by auto
        qed
      ultimately have "α' γ'. (set γ'  N𝒱  ΔΓ  β @ [c] @ γ' @ [v'] @ α'  Tr(ES1  ES2) 
         α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])"
        by (simp only: append_assoc, blast)
    }
    moreover {
      assume Nv2_inter_Delta2_inter_E1_empty: "N𝒱2  ΔΓ2  EES1 = {}" 
        and  Nv1_inter_Delta1_inter_E2_subsetof_Upsilon2: "N𝒱1  ΔΓ1  EES2  ΥΓ2"

      let ?ALPHA1''_DELTA1'' = " α1'' δ1''. (
        set α1''  EES1  set δ1''  N𝒱1  ΔΓ1 
         β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1 
         α1''  V𝒱1 = α1'  V𝒱1  α1''  C𝒱1 = [])"

      from c_in_Cv_inter_Upsilon v'_in_Vv_inter_Nabla validV1
      have "c  EES1  (c  EES1  v'  EES1)  (c  EES1  v'  EES1)"
        by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
          VN_disjoint_def NC_disjoint_def)
      moreover {
        assume c_notin_E1: "c  EES1"

        from validES1 βv'E1α1'_in_Tr1 have "set α1'  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover 
        have "set []  N𝒱1  ΔΓ1"
          by auto
        moreover 
        from βv'E1α1'_in_Tr1 c_notin_E1 
        have "β  EES1 @ [c]  EES1 @ [] @ [v']  EES1 @ α1'  TrES1"
          by (simp add: projection_def)
        moreover
        have "α1'  V𝒱1 = α1'  V𝒱1" ..
        moreover 
        note α1'Cv1_empty
        ultimately have ?ALPHA1''_DELTA1''
          by blast
      }
      moreover {
        assume c_in_E1: "c  EES1"
          and  v'_notin_E1: "v'  EES1"

        from c_in_E1 c_in_Cv_inter_Upsilon propSepViews
          Upsilon_inter_E1_subset_Upsilon1
        have c_in_Cv1_inter_Upsilon1: "c  C𝒱1  ΥΓ1"
          unfolding properSeparationOfViews_def by auto
        hence "c  C𝒱1"
          by auto
        moreover
        from βv'E1α1'_in_Tr1 v'_notin_E1 have "β  EES1 @ α1'  TrES1"
          by (simp add: projection_def)
        moreover
        note α1'Cv1_empty
        moreover
        have "Adm 𝒱1 ρ1 TrES1 (β  EES1) c"
        proof -
          from Adm obtain γ
            where γρv_is_βρv: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
            and γc_in_Tr: "(γ @ [c])  Tr(ES1  ES2)"
            unfolding Adm_def
            by auto

          from c_in_E1 γc_in_Tr have "(γ  EES1) @ [c]  TrES1"
            by (simp add: projection_def composeES_def)
          moreover
          have "γ  EES1  (ρ1 𝒱1) = β  EES1  (ρ1 𝒱1)"
          proof -
            from γρv_is_βρv have "γ  EES1  (ρ 𝒱) = β  EES1  (ρ 𝒱)"
              by (metis projection_commute)
            with ρ1v1_subset_ρv_inter_E1 have "γ  (ρ1 𝒱1) = β  (ρ1 𝒱1)"
              by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
            thus ?thesis
              by (metis projection_commute)
          qed
          ultimately show ?thesis unfolding Adm_def
            by auto
        qed  
        moreover 
        note BSIA1
        ultimately obtain  α1''
          where one: "β  EES1 @ [c] @ α1''  TrES1"
          and two:   "α1''  V𝒱1 = α1'  V𝒱1"
          and three: "α1''  C𝒱1 = []"
          unfolding BSIA_def
          by blast

        from one validES1 have "set α1''  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        have "set []  N𝒱1  ΔΓ1"
          by auto
        moreover
        from one c_in_E1 v'_notin_E1 
        have "β  EES1 @ [c]  EES1 @ [] @ [v']  EES1 @ α1''  TrES1"
          by (simp add: projection_def)
        moreover 
        note two three
        ultimately have ?ALPHA1''_DELTA1''
          by blast
      }
      moreover {
        assume c_in_E1: "c  EES1"
          and  v'_in_E1: "v'  EES1"

        from c_in_E1 c_in_Cv_inter_Upsilon propSepViews
          Upsilon_inter_E1_subset_Upsilon1
        have c_in_Cv1_inter_Upsilon1: "c  C𝒱1  ΥΓ1"
          unfolding properSeparationOfViews_def by auto
        moreover
        from v'_in_E1 propSepViews v'_in_Vv_inter_Nabla 
          Nabla_inter_E1_subset_Nabla1
        have "v'  V𝒱1  Nabla Γ1"
          unfolding properSeparationOfViews_def by auto
        moreover
        from v'_in_E1  βv'E1α1'_in_Tr1 have "β  EES1 @ [v'] @ α1'  TrES1"
          by (simp add: projection_def)
        moreover
        note α1'Cv1_empty 
        moreover
        have "Adm 𝒱1 ρ1 TrES1 (β  EES1) c"
        proof -
          from Adm obtain γ
            where γρv_is_βρv: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
            and γc_in_Tr: "(γ @ [c])  Tr(ES1  ES2)"
            unfolding Adm_def
            by auto

          from c_in_E1 γc_in_Tr have "(γ  EES1) @ [c]  TrES1"
            by (simp add: projection_def composeES_def)
          moreover
          have "γ  EES1  (ρ1 𝒱1) = β  EES1  (ρ1 𝒱1)"
          proof -
            from γρv_is_βρv have "γ  EES1  (ρ 𝒱) = β  EES1  (ρ 𝒱)"
              by (metis projection_commute)
            with ρ1v1_subset_ρv_inter_E1 have "γ  (ρ1 𝒱1) = β  (ρ1 𝒱1)"
              by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
            thus ?thesis
              by (metis projection_commute)
          qed
          ultimately show ?thesis unfolding Adm_def
            by auto
        qed  
        moreover
        note FCIA1
        ultimately obtain α1'' δ1''
          where one: "set δ1''  N𝒱1  ΔΓ1"
          and two: "β  EES1 @ [c] @ δ1'' @ [v'] @ α1''  TrES1"
          and three: "α1''  V𝒱1 = α1'  V𝒱1"
          and four: "α1''  C𝒱1 = []"
          unfolding FCIA_def
          by blast

        from two validES1 have "set α1''  EES1"
          by (simp add: ES_valid_def traces_contain_events_def, auto)
        moreover
        note one
        moreover
        from two c_in_E1 v'_in_E1 
        have "β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1"
          by (simp add: projection_def)
        moreover
        note three four
        ultimately have ?ALPHA1''_DELTA1''
          by blast
      }
      ultimately obtain α1'' δ1''
        where α1''_in_E1star: "set α1''  EES1"
        and δ1''_in_N1_inter_Delta1star:"set δ1''  N𝒱1  ΔΓ1"
        and βE1_cE1_δ1''_v'E1_α1''_in_Tr1: 
          "β  EES1 @ [c]  EES1 @ δ1'' @ [v']  EES1 @ α1''  TrES1"
        and α1''Vv1_is_α1'Vv1: "α1''  V𝒱1 = α1'  V𝒱1"
        and α1''Cv1_empty: "α1''  C𝒱1 = []"
        by blast

      from c_in_Cv_inter_Upsilon Upsilon_inter_E2_subset_Upsilon2 propSepViews
      have cE2_in_Cv2_inter_Upsilon2: "set ([c]  EES2)  C𝒱2  ΥΓ2"
        unfolding properSeparationOfViews_def by (simp add: projection_def, auto)
     
      from δ1''_in_N1_inter_Delta1star Nv1_inter_Delta1_inter_E2_subsetof_Upsilon2 
       propSepViews disjoint_Nv1_Vv2 
      have δ1''E2_in_Cv2_inter_Upsilon2star: "set (δ1''  EES2)  C𝒱2  ΥΓ2"
        proof -
          from δ1''_in_N1_inter_Delta1star 
          have eq: "δ1''  EES2 = δ1''  (N𝒱1  ΔΓ1  EES2)"
            by (metis Int_commute Int_left_commute Int_lower2 Int_lower1 
              projection_intersection_neutral subset_trans)
          
          from validV2 Nv1_inter_Delta1_inter_E2_subsetof_Upsilon2 
            propSepViews disjoint_Nv1_Vv2  
          have "N𝒱1  ΔΓ1  EES2  C𝒱2  ΥΓ2"
            unfolding properSeparationOfViews_def 
            by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
              VN_disjoint_def NC_disjoint_def, auto)
          thus ?thesis
            by (subst eq, simp only: projection_def, auto)
        qed
      
      have cδ1''E2_in_Cv2_inter_Upsilon2star: "set ((c # δ1'')  EES2)  C𝒱2  ΥΓ2"
        proof -
          from cE2_in_Cv2_inter_Upsilon2 δ1''E2_in_Cv2_inter_Upsilon2star
          have "set (([c] @ δ1'')  EES2)  C𝒱2  ΥΓ2"
            by (simp only: projection_concatenation_commute, auto)
          thus ?thesis
            by auto
        qed


      have " α2'' δ2''. set α2''  EES2        
         set δ2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1        
         β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2        
         α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []
         δ2''  EES1 = δ1''  EES2"
        proof cases
          assume v'_in_E2: "v'  EES2"
          with Nabla_inter_E2_subset_Nabla2 propSepViews v'_in_Vv_inter_Nabla
          have v'_in_Vv2_inter_Nabla2: "v'  V𝒱2  Nabla Γ2"
            unfolding properSeparationOfViews_def by auto

          have " (β @ [v'])  EES2 @ α2'  TrES2 ; 
            α2'  C𝒱2 = []; set ((c # δ1'')  EES2)  C𝒱2  ΥΓ2 ; 
            c  C𝒱  ΥΓ ; set δ1''  N𝒱1  ΔΓ1;
            Adm 𝒱 ρ (Tr(ES1  ES2)) β c  
              α2'' δ2''.
           (set α2''  EES2  set δ2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1            
             β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2            
             α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []
             δ2''  (C𝒱2  ΥΓ2) = δ1''  EES2)"
            proof (induct "length ((c # δ1'')  EES2)" arbitrary: β α2' c δ1'')
              case 0

              from 0(2) validES2 have "set α2'  EES2"
                by (simp add: ES_valid_def traces_contain_events_def, auto)
              moreover
              have "set []  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                by auto
              moreover
              have "β  EES2 @ [c]  EES2 @ [] @ [v']  EES2 @ α2'  TrES2"
                proof -
                  note 0(2)
                  moreover
                  from 0(1) have "c  EES2"
                    by (simp add: projection_def, auto)
                  ultimately show ?thesis
                    by (simp add: projection_concatenation_commute projection_def)
                qed
              moreover
              have "α2'  V𝒱2 = α2'  V𝒱2" ..
              moreover
              note 0(3)
              moreover 
              from 0(1) have "[]  (C𝒱2  ΥΓ2) = δ1''  EES2"
                by (simp add: projection_def, split if_split_asm, auto)
              ultimately show ?case
                by blast
            next
              case (Suc n)

              from projection_split_last[OF Suc(2)] obtain μ c' ν
                where c'_in_E2: "c'  EES2"
                and cδ1''_is_μc'ν: "c # δ1'' = μ @ [c'] @ ν"
                and νE2_empty: "ν  EES2 = []"
                and n_is_length_μνE2: "n = length ((μ @ ν)  EES2)"
                by blast

              from Suc(5) c'_in_E2 cδ1''_is_μc'ν have "set (μ  EES2 @ [c'])  C𝒱2  ΥΓ2"
                by (simp only: cδ1''_is_μc'ν projection_concatenation_commute 
                  projection_def, auto)
              hence c'_in_Cv2_inter_Upsilon2: "c'  C𝒱2  ΥΓ2"
                by auto
              hence c'_in_Cv2: "c'  C𝒱2" and c'_in_Upsilon2: "c'  ΥΓ2"
                by auto
              with validV2 have c'_in_E2: "c'  EES2"
                by (simp add: isViewOn_def V_valid_def
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)

              show ?case
                proof (cases μ)
                  case Nil (* we apply FCIA in this case *)
                  with cδ1''_is_μc'ν have c_is_c': "c = c'" and δ1''_is_ν: "δ1'' = ν"
                    by auto
                  with c'_in_Cv2_inter_Upsilon2 have "c  C𝒱2  ΥΓ2"
                    by simp
                  moreover
                  note v'_in_Vv2_inter_Nabla2
                  moreover
                  from v'_in_E2 Suc(3) have "(β  EES2) @ [v'] @ α2'  TrES2"
                    by (simp add: projection_concatenation_commute projection_def)
                  moreover
                  note Suc(4)
                  moreover
                  have "Adm 𝒱2 ρ2 TrES2 (β  EES2) c"
                    proof -
                      from Suc(8) obtain γ
                        where γρv_is_βρv: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
                        and γc_in_Tr: "(γ @ [c])  Tr(ES1  ES2)"
                        unfolding Adm_def
                        by auto

                      from c_is_c' c'_in_E2 γc_in_Tr have "(γ  EES2) @ [c]  TrES2"
                        by (simp add: projection_def composeES_def)
                      moreover
                      have "γ  EES2  (ρ2 𝒱2) = β  EES2  (ρ2 𝒱2)"
                      proof -
                        from γρv_is_βρv have "γ  EES2  (ρ 𝒱) = β  EES2  (ρ 𝒱)"
                          by (metis projection_commute)
                        with ρ2v2_subset_ρv_inter_E2 have "γ  (ρ2 𝒱2) = β  (ρ2 𝒱2)"
                          by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
                        thus ?thesis
                          by (metis projection_commute)
                      qed
                      ultimately show ?thesis unfolding Adm_def
                        by auto
                    qed  
                  moreover
                  note FCIA2
                  ultimately obtain α2'' γ
                    where one: "set γ  N𝒱2  ΔΓ2"
                    and two: "β  EES2 @ [c] @ γ @ [v'] @ α2''  TrES2"
                    and three: "α2''  V𝒱2 = α2'  V𝒱2"
                    and four: "α2''  C𝒱2 = []"
                    unfolding FCIA_def
                    by blast

                  (* we choose δ2'' = ν ↿ EES2 @ γ *)
                  let ?DELTA2'' = "ν  EES2 @ γ" 
                    
                  from two validES2 have "set α2''  EES2"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  from one νE2_empty
                  have "set ?DELTA2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    by auto
                  moreover
                  have "β  EES2 @ [c]  EES2 @ ?DELTA2'' @ [v']  EES2 @ α2''  TrES2"
                    proof -
                      from c_is_c' c'_in_E2 have "[c] = [c]  EES2"
                        by (simp add: projection_def)
                      moreover
                      from v'_in_E2 have "[v'] = [v']  EES2"
                        by (simp add: projection_def)
                      moreover
                      note νE2_empty two
                      ultimately show ?thesis
                        by auto
                    qed
                  moreover
                  note three four
                  moreover
                  have "?DELTA2''  (C𝒱2  ΥΓ2) = δ1''  EES2"
                    proof -
                      have "γ  (C𝒱2  ΥΓ2) = []"
                        proof -
                          from validV2 have "N𝒱2  ΔΓ2  (C𝒱2  ΥΓ2) = {}"
                            by (simp add: isViewOn_def V_valid_def
                              VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                          with projection_intersection_neutral[OF one, of "C𝒱2  ΥΓ2"]
                          show ?thesis
                            by (simp add: projection_def)
                        qed
                      with δ1''_is_ν νE2_empty show ?thesis
                        by (simp add: projection_concatenation_commute)
                    qed
                  ultimately show ?thesis
                    by blast
                next
                  case (Cons x xs) (* we apply the inductive hypothesis in this case *)
                  with cδ1''_is_μc'ν
                  have μ_is_c_xs: "μ = [c] @ xs" and δ1''_is_xs_c'_ν: "δ1'' = xs @ [c'] @ ν"
                    by auto
                  with n_is_length_μνE2 have "n = length ((c # (xs @ ν))  EES2)"
                    by auto
                  moreover
                  note Suc(3,4)
                  moreover
                  have "set ((c # (xs @ ν))  EES2)  C𝒱2  ΥΓ2"
                    proof -
                      have res: "c # (xs @ ν) = [c] @ (xs @ ν)" 
                        by auto

                      from Suc(5) cδ1''_is_μc'ν μ_is_c_xs νE2_empty
                      show ?thesis
                        by (subst res, simp only: cδ1''_is_μc'ν 
                          projection_concatenation_commute set_append, auto)
                    qed
                  moreover
                  note Suc(6) 
                  moreover
                  from Suc(7) δ1''_is_xs_c'_ν have "set (xs @ ν)  N𝒱1  ΔΓ1"
                    by auto
                  moreover note Suc(8) Suc(1)[of c "xs @ ν" β α2']
                  ultimately obtain δ γ
                    where one: "set δ  EES2"
                    and two: "set γ  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    and three: "β  EES2 @ [c]  EES2 @ γ @ [v']  EES2 @ δ  TrES2"
                    and four: "δ  V𝒱2 = α2'  V𝒱2"
                    and five: "δ  C𝒱2 = []"
                    and six: "γ  (C𝒱2  ΥΓ2) = (xs @ ν)  EES2"
                    by blast

                  (* apply FCIA to insert c' after γ *)
                  let ?BETA = "β  EES2 @ [c]  EES2 @ γ"

                  note c'_in_Cv2_inter_Upsilon2 v'_in_Vv2_inter_Nabla2
                  moreover
                  from three v'_in_E2 have "?BETA @ [v'] @ δ  TrES2"
                    by (simp add: projection_def)
                  moreover
                  note five 
                  moreover
                  have "Adm 𝒱2 ρ2 TrES2 ?BETA c'"
                    proof -
                      have "?BETA @ [c']  TrES2"
                        proof -
                          from Suc(7) c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν
                          have "c'  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                            by auto
                          moreover
                          from validES2 three have "?BETA  TrES2"
                            by (unfold ES_valid_def traces_prefixclosed_def
                              prefixclosed_def prefix_def, auto)
                          moreover
                          note total_ES2_C2_inter_Upsilon2_inter_N1_inter_Delta1
                          ultimately show ?thesis
                            unfolding total_def
                            by blast
                        qed
                      thus ?thesis
                        unfolding Adm_def
                        by blast                        
                    qed
                  moreover
                  note FCIA2
                  ultimately obtain α2'' δ'
                    where fcia_one: "set δ'  N𝒱2  ΔΓ2"
                    and fcia_two: "?BETA @ [c'] @ δ' @ [v'] @ α2''  TrES2"
                    and fcia_three: "α2''  V𝒱2 = δ  V𝒱2"
                    and fcia_four:  "α2''  C𝒱2 = []"
                    unfolding FCIA_def
                    by blast
  
                  let ?DELTA2'' = "γ @ [c'] @ δ'"

                  from fcia_two validES2 have "set α2''  EES2"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  have "set ?DELTA2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    proof -
                      from Suc(7) c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν 
                      have "c'   C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                        by auto
                      with two fcia_one show ?thesis
                        by auto
                    qed
                  moreover
                  from fcia_two v'_in_E2 
                  have "β  EES2 @ [c]  EES2 @ ?DELTA2'' @ [v']  EES2 @ α2''  TrES2"
                    by (simp add: projection_def)
                  moreover
                  from fcia_three four have "α2''  V𝒱2 = α2'  V𝒱2"
                    by simp
                  moreover
                  note fcia_four
                  moreover             
                  have "?DELTA2''  (C𝒱2  ΥΓ2) = δ1''  EES2"
                    proof -
                      have "δ'  (C𝒱2  ΥΓ2) = []"
                        proof -
                          from fcia_one have " e  set δ'. e  N𝒱2  ΔΓ2"
                            by auto
                          with validV2 have " e  set δ'. e  C𝒱2  ΥΓ2"
                            by (simp add:isViewOn_def V_valid_def 
                              VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                          thus ?thesis
                            by (simp add: projection_def)
                        qed
                      with c'_in_E2 c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν νE2_empty six 
                      show ?thesis
                        by (simp only: projection_concatenation_commute projection_def, auto)
                    qed
                  ultimately show ?thesis 
                    by blast     
                qed
          qed
          from this[OF βv'E2α2'_in_Tr2 α2'Cv2_empty 
            cδ1''E2_in_Cv2_inter_Upsilon2star c_in_Cv_inter_Upsilon δ1''_in_N1_inter_Delta1star Adm]
          obtain α2'' δ2''
            where one: "set α2''  EES2"
            and two: "set δ2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
            and three: "β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2            
             α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []"
            and four: "δ2''  (C𝒱2  ΥΓ2) = δ1''  EES2"
            by blast

          note one two three
          moreover
          have "δ2''  EES1 = δ1''  EES2" 
            proof -
              from projection_intersection_neutral[OF two, of "EES1"] 
                Nv2_inter_Delta2_inter_E1_empty validV1 
              have "δ2''  EES1 = δ2''  (C𝒱2  ΥΓ2  N𝒱1  ΔΓ1  EES1)"
                by (simp only: Int_Un_distrib2, auto)
              moreover
              from validV1
              have "C𝒱2  ΥΓ2  N𝒱1  ΔΓ1  EES1 = C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                by (simp add: isViewOn_def V_valid_def VC_disjoint_def 
                  VN_disjoint_def NC_disjoint_def, auto)
              ultimately have "δ2''  EES1 = δ2''  (C𝒱2  ΥΓ2  N𝒱1  ΔΓ1)"
                by simp
              hence "δ2''  EES1 = δ2''  (C𝒱2  ΥΓ2)  (N𝒱1  ΔΓ1)"
                by (simp add: projection_def)
              with four have "δ2''  EES1 = δ1''  EES2  (N𝒱1  ΔΓ1)"
                by simp
              hence "δ2''  EES1 = δ1''  (N𝒱1  ΔΓ1)  EES2"
                by (simp only: projection_commute)
              with δ1''_in_N1_inter_Delta1star show ?thesis
                by (simp only: list_subset_iff_projection_neutral)
            qed
          ultimately show ?thesis
              by blast
        next
          assume v'_notin_E2: "v'  EES2"

           have " (β @ [v'])  EES2 @ α2'  TrES2 ; 
            α2'  C𝒱2 = []; set ((c # δ1'')  EES2)  C𝒱2  ΥΓ2 ; 
             c  C𝒱  ΥΓ ; set δ1''  N𝒱1  ΔΓ1;
            Adm 𝒱 ρ (Tr(ES1  ES2)) β c  
              α2'' δ2''.
             (set α2''  EES2  set δ2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1            
              β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2            
              α2''  V𝒱2 = α2'  V𝒱2  α2''  C𝒱2 = []
             δ2''  EES1 = δ1''  EES2)"
            proof (induct "length ((c # δ1'')  EES2)" arbitrary: β α2' c δ1'')
               case 0

              from 0(2) validES2 have "set α2'  EES2"
                by (simp add: ES_valid_def traces_contain_events_def, auto)
              moreover
              have "set []  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                by auto
              moreover
              have "β  EES2 @ [c]  EES2 @ [] @ [v']  EES2 @ α2'  TrES2"
                proof -
                  note 0(2)
                  moreover
                  from 0(1) have "c  EES2"
                    by (simp add: projection_def, auto)
                  ultimately show ?thesis
                    by (simp add: projection_concatenation_commute projection_def)
                qed
              moreover
              have "α2'  V𝒱2 = α2'  V𝒱2" ..
              moreover
              note 0(3)
              moreover 
              from 0(1) have "[]  EES1 = δ1''  EES2"
                by (simp add: projection_def, split if_split_asm, auto)
              ultimately show ?case
                by blast
            next
              case (Suc n)

              from projection_split_last[OF Suc(2)] obtain μ c' ν
                where c'_in_E2: "c'  EES2"
                and cδ1''_is_μc'ν: "c # δ1'' = μ @ [c'] @ ν"
                and νE2_empty: "ν  EES2 = []"
                and n_is_length_μνE2: "n = length ((μ @ ν)  EES2)"
                by blast

              from Suc(5) c'_in_E2 cδ1''_is_μc'ν have "set (μ  EES2 @ [c'])  C𝒱2  ΥΓ2"
                by (simp only: cδ1''_is_μc'ν projection_concatenation_commute projection_def, auto)
              hence c'_in_Cv2_inter_Upsilon2: "c'  C𝒱2  ΥΓ2"
                by auto
              hence c'_in_Cv2: "c'  C𝒱2" and c'_in_Upsilon2: "c'  ΥΓ2"
                by auto
              with validV2 have c'_in_E2: "c'  EES2"
                by (simp add:isViewOn_def V_valid_def 
                  VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)

              show ?case
                proof (cases μ)
                  case Nil (* we just apply BSIA in this case *)
                  with cδ1''_is_μc'ν have c_is_c': "c = c'" and δ1''_is_ν: "δ1'' = ν"
                    by auto
                  with c'_in_Cv2_inter_Upsilon2 have "c  C𝒱2"
                    by simp
                  moreover
                  from v'_notin_E2 Suc(3) have "(β  EES2) @ α2'  TrES2"
                    by (simp add: projection_concatenation_commute projection_def)
                  moreover
                  note Suc(4)
                  moreover
                  have "Adm 𝒱2 ρ2 TrES2 (β  EES2) c"
                     proof -
                      from Suc(8) obtain γ
                        where γρv_is_βρv: "γ  (ρ 𝒱) = β  (ρ 𝒱)"
                        and γc_in_Tr: "(γ @ [c])  Tr(ES1  ES2)"
                        unfolding Adm_def
                        by auto

                      from c_is_c' c'_in_E2 γc_in_Tr have "(γ  EES2) @ [c]  TrES2"
                        by (simp add: projection_def composeES_def)
                      moreover
                      have "γ  EES2  (ρ2 𝒱2) = β  EES2  (ρ2 𝒱2)"
                      proof -
                        from γρv_is_βρv have "γ  EES2  (ρ 𝒱) = β  EES2  (ρ 𝒱)"
                          by (metis projection_commute)
                        with ρ2v2_subset_ρv_inter_E2 
                        have "γ  (ρ2 𝒱2) = β  (ρ2 𝒱2)"
                          by (metis Int_subset_iff γρv_is_βρv projection_subset_elim)
                        thus ?thesis
                          by (metis projection_commute)
                      qed
                      ultimately show ?thesis unfolding Adm_def
                        by auto
                    qed  
                  moreover
                  note BSIA2
                  ultimately obtain α2''
                    where one: "(β  EES2) @ [c] @ α2''  TrES2"
                    and two: "α2''  V𝒱2 = α2'  V𝒱2"
                    and three: "α2''  C𝒱2 = []"
                    unfolding BSIA_def
                    by blast

                  let ?DELTA2'' = "ν  EES2"

                  from one validES2 have "set α2''  EES2"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  from νE2_empty
                  have "set ?DELTA2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    by simp
                  moreover
                  from c_is_c' c'_in_E2 one v'_notin_E2 νE2_empty
                  have "(β  EES2) @ [c]  EES2 @ ?DELTA2'' @ [v']  EES2 @ α2''  TrES2"
                    by (simp add: projection_def)
                  moreover
                  note two three
                  moreover
                  from νE2_empty δ1''_is_ν have "?DELTA2''  EES1 = δ1''  EES2"
                    by (simp add: projection_def)
                  ultimately show ?thesis
                    by blast
                next
                  case (Cons x xs) (* apply inductive hypothesis, then BSIA *)
                   with cδ1''_is_μc'ν have μ_is_c_xs: "μ = [c] @ xs" 
                     and δ1''_is_xs_c'_ν: "δ1'' = xs @ [c'] @ ν"
                    by auto
                  with n_is_length_μνE2 have "n = length ((c # (xs @ ν))  EES2)"
                    by auto
                  moreover
                  note Suc(3,4)
                  moreover
                  have "set ((c # (xs @ ν))  EES2)  C𝒱2  ΥΓ2"
                    proof -
                      have res: "c # (xs @ ν) = [c] @ (xs @ ν)" 
                        by auto

                      from Suc(5) cδ1''_is_μc'ν μ_is_c_xs νE2_empty
                      show ?thesis
                        by (subst res, simp only: cδ1''_is_μc'ν 
                          projection_concatenation_commute set_append, auto)
                    qed
                  moreover
                  note Suc(6) 
                  moreover
                  from Suc(7) δ1''_is_xs_c'_ν have "set (xs @ ν)  N𝒱1  ΔΓ1"
                    by auto
                  moreover note Suc(8) Suc(1)[of c "xs @ ν" β α2']
                  ultimately obtain δ γ
                    where one: "set δ  EES2"
                    and two: "set γ  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    and three: "β  EES2 @ [c]  EES2 @ γ @ [v']  EES2 @ δ  TrES2"
                    and four: "δ  V𝒱2 = α2'  V𝒱2"
                    and five: "δ  C𝒱2 = []"
                    and six: "γ  EES1 = (xs @ ν)  EES2"
                    by blast
                  
                   (* apply BSIA to insert c' after γ *)
                  let ?BETA = "β  EES2 @ [c]  EES2 @ γ"

                  from c'_in_Cv2_inter_Upsilon2 have "c'  C𝒱2"
                    by auto
                  moreover
                  from three v'_notin_E2 have "?BETA @ δ  TrES2"
                    by (simp add: projection_def)
                  moreover
                  note five 
                  moreover
                  have "Adm 𝒱2 ρ2 TrES2 ?BETA c'"
                    proof -
                      have "?BETA @ [c']  TrES2"
                        proof -
                          from Suc(7) c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν
                          have "c'  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                            by auto
                          moreover
                          from validES2 three have "?BETA  TrES2"
                            by (unfold ES_valid_def traces_prefixclosed_def
                              prefixclosed_def prefix_def, auto)
                          moreover
                          note total_ES2_C2_inter_Upsilon2_inter_N1_inter_Delta1
                          ultimately show ?thesis
                            unfolding total_def
                            by blast
                        qed
                      thus ?thesis
                        unfolding Adm_def
                        by blast                      
                    qed
                  moreover
                  note BSIA2
                  ultimately obtain α2''
                    where bsia_one: "?BETA @ [c'] @ α2''  TrES2"
                    and bsia_two: "α2''  V𝒱2 = δ  V𝒱2"
                    and bsia_three:  "α2''  C𝒱2 = []"
                    unfolding BSIA_def
                    by blast
  
                  let ?DELTA2'' = "γ @ [c']"

                  from bsia_one validES2 have "set α2''  EES2"
                    by (simp add: ES_valid_def traces_contain_events_def, auto)
                  moreover
                  have "set ?DELTA2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                    proof -
                      from Suc(7) c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν 
                      have "c'   C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
                        by auto
                      with two show ?thesis
                        by auto
                    qed
                  moreover
                  from bsia_one v'_notin_E2 
                  have "β  EES2 @ [c]  EES2 @ ?DELTA2'' @ [v']  EES2 @ α2''  TrES2"
                    by (simp add: projection_def)
                  moreover
                  from bsia_two four have "α2''  V𝒱2 = α2'  V𝒱2"
                    by simp
                  moreover
                  note bsia_three
                  moreover             
                  have "?DELTA2''  EES1 = δ1''  EES2"
                    proof -
                      from validV1 Suc(7) δ1''_is_xs_c'_ν have "c'  EES1"
                        by (simp add: isViewOn_def V_valid_def 
                          VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
                      with c'_in_E2 c'_in_Cv2_inter_Upsilon2 δ1''_is_xs_c'_ν νE2_empty six 
                      show ?thesis
                        by (simp only: projection_concatenation_commute projection_def, auto)
                    qed
                  ultimately show ?thesis 
                    by blast     
                qed
            qed
          from this[OF βv'E2α2'_in_Tr2 α2'Cv2_empty cδ1''E2_in_Cv2_inter_Upsilon2star 
            c_in_Cv_inter_Upsilon δ1''_in_N1_inter_Delta1star Adm]
          show ?thesis 
            by blast
        qed
      then obtain α2'' δ2''
        where α2''_in_E2star: "set α2''  EES2"
        and δ2''_in_N2_inter_Delta2star:"set δ2''  N𝒱2  ΔΓ2  C𝒱2  ΥΓ2  N𝒱1  ΔΓ1"
        and βE2_cE2_δ2''_v'E2_α2''_in_Tr2: 
        "β  EES2 @ [c]  EES2 @ δ2'' @ [v']  EES2 @ α2''  TrES2"
        and α2''Vv2_is_α2'Vv2: "α2''  V𝒱2 = α2'  V𝒱2"
        and α2''Cv2_empty: "α2''  C𝒱2 = []"
        and δ2''E1_is_δ1''E2: "δ2''  EES1 = δ1''  EES2"
        by blast

      from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 βE1_cE1_δ1''_v'E1_α1''_in_Tr1 
        validES2 validES1
      have δ2''_in_E2star: "set δ2''  EES2" and δ1''_in_E1star: "set δ1''  EES1"
        by (simp_all add: ES_valid_def traces_contain_events_def, auto)
      with δ2''E1_is_δ1''E2 merge_property[of δ2'' "EES2" δ1'' "EES1"] obtain δ'
        where δ'E2_is_δ2'': "δ'  EES2 = δ2''"
        and δ'E1_is_δ1'': "δ'  EES1 = δ1''"
        and δ'_contains_only_δ2''_δ1''_events: "set δ'  set δ2''  set δ1''"
        unfolding Let_def
        by auto

      let ?TAU = "β @ [c] @ δ' @ [v']"
      let ?LAMBDA = "α  V𝒱"
      let ?T2 = α2''
      let ?T1 = α1''

     (* apply the generalized zipping lemma *)
     have "?TAU  Tr(ES1  ES2)"
        proof -
          from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 δ'E2_is_δ2'' validES2
          have "β  EES2 @ [c]  EES2 @ δ'  EES2 @ [v']  EES2  TrES2"
            by (simp add: ES_valid_def traces_prefixclosed_def
              prefixclosed_def prefix_def)
          hence "(β @ [c] @ δ' @ [v'])  EES2  TrES2"
            by (simp add: projection_def, auto)
          moreover          
          from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 δ'E1_is_δ1'' validES1 
          have "β  EES1 @ [c]  EES1 @ δ'  EES1 @ [v']  EES1  TrES1"
            by (simp add: ES_valid_def traces_prefixclosed_def
              prefixclosed_def prefix_def)
          hence "(β @ [c] @ δ' @ [v'])  EES1  TrES1"
            by (simp add: projection_def, auto)
          moreover
          from βv'α_in_Tr c_in_Cv_inter_Upsilon VIsViewOnE
            δ'_contains_only_δ2''_δ1''_events δ2''_in_E2star δ1''_in_E1star
          have "set (β @ [c] @ δ' @ [v'])  EES2  EES1"
            unfolding composeES_def isViewOn_def V_valid_def 
              VC_disjoint_def VN_disjoint_def NC_disjoint_def
            by auto
          ultimately show ?thesis
            unfolding composeES_def
            by auto
        qed 
      hence "set ?TAU  E(ES1  ES2)"
        unfolding composeES_def
        by auto
      moreover
      have "set ?LAMBDA  V𝒱"
        by (simp add: projection_def, auto)
      moreover
      note α2''_in_E2star α1''_in_E1star
      moreover
      from βE2_cE2_δ2''_v'E2_α2''_in_Tr2 δ'E2_is_δ2'' 
      have "?TAU  EES2 @ ?T2  TrES2"
        by (simp only: projection_concatenation_commute, auto)
      moreover
      from βE1_cE1_δ1''_v'E1_α1''_in_Tr1 δ'E1_is_δ1'' 
      have "?TAU  EES1 @ ?T1  TrES1"
        by (simp only: projection_concatenation_commute, auto)
      moreover
      have "?LAMBDA  EES2 = ?T2  V𝒱"
        proof -
          from propSepViews have "?LAMBDA  EES2 = α  V𝒱2"
            unfolding properSeparationOfViews_def by (simp only: projection_sequence)
          moreover
          from α2''_in_E2star propSepViews have "?T2  V𝒱 = ?T2  V𝒱2"
            unfolding properSeparationOfViews_def
            by (metis Int_commute projection_intersection_neutral)
          moreover
          note α2'Vv2_is_αVv2 α2''Vv2_is_α2'Vv2
          ultimately show ?thesis
            by simp
        qed
      moreover
      have "?LAMBDA  EES1 = ?T1  V𝒱"
        proof -
          from propSepViews have "?LAMBDA  EES1 = α  V𝒱1"
            unfolding properSeparationOfViews_def by (simp only: projection_sequence)
          moreover
          from α1''_in_E1star propSepViews have "?T1  V𝒱 = ?T1  V𝒱1"
            unfolding properSeparationOfViews_def
            by (metis Int_commute projection_intersection_neutral)
          moreover
          note α1'Vv1_is_αVv1 α1''Vv1_is_α1'Vv1
          ultimately show ?thesis
            by simp
        qed
      moreover
      note α2''Cv2_empty α1''Cv1_empty generalized_zipping_lemma
      ultimately obtain t (* show that the conclusion of FCIA holds *)
        where "?TAU @ t  Tr(ES1  ES2)"
        and  "t  V𝒱 = ?LAMBDA"
        and "t  C𝒱 = []"
        by blast
      moreover
      have "set δ'  N𝒱  ΔΓ"
        proof -
          from δ'_contains_only_δ2''_δ1''_events 
            δ2''_in_N2_inter_Delta2star δ1''_in_N1_inter_Delta1star
          have "set δ'  N𝒱2  ΔΓ2  N𝒱1  ΔΓ1"
            by auto
          with Delta1_N1_Delta2_N2_subset_Delta Nv1_union_Nv2_subsetof_Nv show ?thesis
            by auto
        qed
      ultimately have "α' γ'. (set γ'  N𝒱  ΔΓ  β @ [c] @ γ' @ [v'] @ α'  Tr(ES1  ES2) 
         α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])"
        by (simp only: append_assoc, blast)
    }
    ultimately have "α' γ'. (set γ'  N𝒱  ΔΓ  β @ [c] @ γ' @ [v'] @ α'  Tr(ES1  ES2) 
       α'  V𝒱 = α  V𝒱  α'  C𝒱 = [])"
      by blast
  }
  thus ?thesis
    unfolding FCIA_def
    by blast
qed

(* Theorem 6.4.2 *)
theorem compositionality_R: 
" R 𝒱1 TrES1; R 𝒱2 TrES2   R 𝒱 (Tr(ES1  ES2))"
  proof -
    assume R1: "R 𝒱1 TrES1"
    and R2: "R 𝒱2 TrES2"

    {
      fix τ'
      assume τ'_in_Tr: "τ'  Tr(ES1  ES2)"
      hence τ'E1_in_Tr1: "τ'  EES1  TrES1"
        and τ'E2_in_Tr2: "τ'  EES2  TrES2"
        unfolding composeES_def
        by auto
      with R1 R2 obtain τ1' τ2'
        where τ1'_in_Tr1: "τ1'  TrES1"
        and τ1'Cv1_empty: "τ1'  C𝒱1 = []"
        and τ1'Vv1_is_τ'_E1_Vv1: "τ1'  V𝒱1 = τ'  EES1  V𝒱1"
        and τ2'_in_Tr2: "τ2'  TrES2"
        and τ2'Cv2_empty: "τ2'  C𝒱2 = []"
        and τ2'Vv2_is_τ'_E2_Vv2: "τ2'  V𝒱2 = τ'  EES2  V𝒱2"
        unfolding R_def
        by blast

      have "set []  E(ES1  ES2)"
        by auto
      moreover
      have "set (τ'  V𝒱)  V𝒱"
        by (simp add: projection_def, auto)
      moreover
      from validES1 τ1'_in_Tr1 have τ1'_in_E1: "set τ1'  EES1"
        by (simp add: ES_valid_def traces_contain_events_def, auto)
      moreover
      from validES2 τ2'_in_Tr2 have τ2'_in_E2: "set τ2'  EES2"
        by (simp add: ES_valid_def traces_contain_events_def, auto)
      moreover
      from τ1'_in_Tr1 have "[]  EES1 @ τ1'  TrES1"
        by (simp add: projection_def)
      moreover
      from τ2'_in_Tr2 have "[]  EES2 @ τ2'  TrES2"
        by (simp add: projection_def)
      moreover
      have "τ'  V𝒱  EES1 = τ1'  V𝒱"
        proof -
          from projection_intersection_neutral[OF τ1'_in_E1, of "V𝒱"] propSepViews 
          have "τ1'  V𝒱 = τ1'  V𝒱1"
            unfolding properSeparationOfViews_def
            by (simp add: Int_commute)
          moreover
          from  propSepViews have "τ'  V𝒱  EES1 = τ'  V𝒱1"
            unfolding properSeparationOfViews_def
            by (simp add: projection_sequence)
          moreover {
            have " τ'  EES1  V𝒱1 = τ'  (EES1  V𝒱1)"
              by (simp add: projection_def)
            moreover
            from validV1 have "EES1  V𝒱1 = V𝒱1"
              by (simp add: isViewOn_def V_valid_def 
                VC_disjoint_def VN_disjoint_def NC_disjoint_def, auto)
            ultimately have "τ'  EES1  V𝒱1 = τ'  V𝒱1"
              by simp
            }
          moreover
          note τ1'Vv1_is_τ'_E1_Vv1
          ultimately show ?thesis
            by simp
        qed
      moreover
      have "τ'  V𝒱  EES2 = τ2'  V𝒱"
        proof -
          from projection_intersection_neutral[OF τ2'_in_E2, of "V𝒱"] propSepViews
          have "τ2'  V𝒱 = τ2'  V𝒱2"
            unfolding properSeparationOfViews_def
            by (simp add: Int_commute)
          moreover
          from  propSepViews have "τ'  V𝒱  EES2 = τ'  V𝒱2"
            unfolding properSeparationOfViews_def
            by (simp add: projection_sequence)
          moreover {
            have " τ'  EES2  V𝒱2 = τ'  (EES2  V𝒱2)"
              by (simp add: projection_def)
            moreover
            from validV2 have "EES2  V𝒱2 = V𝒱2"
              by (simp add:isViewOn_def V_valid_def VC_disjoint_def 
                VN_disjoint_def NC_disjoint_def, auto)
            ultimately have "τ'  EES2  V𝒱2 = τ'  V𝒱2"
              by simp
            }
          moreover
          note τ2'Vv2_is_τ'_E2_Vv2
          ultimately show ?thesis
            by simp
        qed
      moreover
      note τ1'Cv1_empty τ2'Cv2_empty generalized_zipping_lemma
      ultimately have "t. [] @ t  Tr(ES1  ES2)  t  V𝒱 = τ'  V𝒱  t  C𝒱 = []"
        by blast
    }
    thus ?thesis
      unfolding R_def
      by auto
  qed

end

locale CompositionalityStrictBSPs = Compositionality +
(*adds the additional assumptions of theorem 6.4.3 in Heiko Mantel's phd thesis*)
assumes N𝒱_inter_E1_is_N𝒱1: "N𝒱  EES1 = N𝒱1"
    and N𝒱_inter_E2_is_N𝒱2: "N𝒱  EES2 = N𝒱2"

(* sublocale relationship to other compositionality assumptions*)
sublocale CompositionalityStrictBSPs  Compositionality
by (unfold_locales)

context CompositionalityStrictBSPs
begin
(*Theorem 6.4.3 Case 1 in Heiko Mantel's pdh thesis*)
theorem compositionality_SR: 
" SR 𝒱1 TrES1; SR 𝒱2 TrES2   SR 𝒱 (Tr(ES1  ES2))" 
proof -
  assume "SR 𝒱1 TrES1"
     and "SR 𝒱2 TrES2"
  { 
    let ?𝒱1'="V = V𝒱1  N𝒱1, N = {}, C = C𝒱1"
    let ?𝒱2'="V = V𝒱2  N𝒱2, N = {}, C = C𝒱2 "
    let ?𝒱' ="V=V𝒱  N𝒱, N={}, C=C𝒱 " 
    (*Show ?𝒱1' ?𝒱2' ?𝒱' are views on the respective set of events*)
    from validV1 have 𝒱1'IsViewOnE1: "isViewOn ?𝒱1' EES1 " 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    from validV2 have 𝒱2'IsViewOnE2: "isViewOn ?𝒱2' EES2 " 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    from VIsViewOnE have 𝒱'IsViewOnE: "isViewOn  ?𝒱' E(ES1ES2)" 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    
    (*Show ?𝒱1' and ?𝒱2' are proper separation of ⦇ V=𝒱, N={}, C=𝒱 ⦈ *)
     from propSepViews  N𝒱_inter_E1_is_N𝒱1
     have "V?𝒱'  EES1 = V?𝒱1'"
       unfolding properSeparationOfViews_def by auto
     from propSepViews   N𝒱_inter_E2_is_N𝒱2
     have "V?𝒱'  EES2 = V?𝒱2'"
       unfolding properSeparationOfViews_def by auto
     from propSepViews 
     have  "C?𝒱'  EES1  C?𝒱1'"
       unfolding properSeparationOfViews_def by auto      
     from propSepViews
     have  "C?𝒱'  EES2  C?𝒱2'"
       unfolding properSeparationOfViews_def by auto
     have "N?𝒱1'  N?𝒱2' ={}"
       by auto
     
     note properSeparation_𝒱1𝒱2=‹V?𝒱'  EES1 = V?𝒱1' ‹V?𝒱'  EES2 = V?𝒱2' 
              ‹C?𝒱'  EES1  C?𝒱1' ‹C?𝒱'  EES2  C?𝒱2' ‹N?𝒱1'  N?𝒱2' ={}
    
    (*Show ES1∥ES2 is a well behaved composition w.r.t.  ?𝒱1' and ?𝒱2' *)
     have wbc1: "N?𝒱1'  EES1={}  N?𝒱2'  EES2={}"
       by auto
     
     
    from ‹SR 𝒱1 TrES1  have "R ?𝒱1' TrES1"      
      using validES1 validV1 BSPTaxonomyDifferentCorrections.SR_implies_R_for_modified_view  
      unfolding  BSPTaxonomyDifferentCorrections_def by auto
    from ‹SR 𝒱2 TrES2  have "R ?𝒱2' TrES2"     
      using validES2 validV2  BSPTaxonomyDifferentCorrections.SR_implies_R_for_modified_view 
      unfolding BSPTaxonomyDifferentCorrections_def by auto   
 
    from validES1 validES2 composableES1ES2  𝒱'IsViewOnE 𝒱1'IsViewOnE1 𝒱2'IsViewOnE2
         properSeparation_𝒱1𝒱2  wbc1
    have "Compositionality ES1 ES2 ?𝒱' ?𝒱1' ?𝒱2'" unfolding Compositionality_def 
      by (simp add: properSeparationOfViews_def wellBehavedComposition_def)
    with ‹R ?𝒱1' TrES1 ‹R ?𝒱2' TrES2 have "R ?𝒱' Tr(ES1ES2)" 
     using Compositionality.compositionality_R by blast
     
   from  validES1 validES2 composeES_yields_ES validVC
   have "BSPTaxonomyDifferentCorrections (ES1ES2) 𝒱"
      unfolding BSPTaxonomyDifferentCorrections_def by auto 
    with ‹R ?𝒱' Tr(ES1ES2) have "SR 𝒱 Tr(ES1ES2)" 
      using BSPTaxonomyDifferentCorrections.R_implies_SR_for_modified_view  by auto 
  }
  thus ?thesis by auto  
qed

(*Theorem 6.4.3 Case 2 in Heiko Mantel's pdh thesis*)
theorem compositionality_SD: 
" SD 𝒱1 TrES1; SD 𝒱2 TrES2   SD 𝒱 (Tr(ES1  ES2))" 
proof -
  assume "SD 𝒱1 TrES1"
     and "SD 𝒱2 TrES2"
  { 
    let ?𝒱1'="V = V𝒱1  N𝒱1, N = {}, C = C𝒱1"
    let ?𝒱2'="V = V𝒱2  N𝒱2, N = {}, C = C𝒱2 "
    let ?𝒱' ="V=V𝒱  N𝒱, N={}, C=C𝒱 " 
    (*Show ?𝒱1' ?𝒱2' ?𝒱' are views on the respective set of events*)
    from validV1 have 𝒱1'IsViewOnE1: "isViewOn ?𝒱1' EES1 " 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    from validV2 have 𝒱2'IsViewOnE2: "isViewOn ?𝒱2' EES2 " 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    from VIsViewOnE have 𝒱'IsViewOnE: "isViewOn  ?𝒱' E(ES1ES2)" 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    
    (*Show ?𝒱1' and ?𝒱2' are proper separation of ⦇ V=𝒱, N={}, C=𝒱 ⦈ *)
     from propSepViews  N𝒱_inter_E1_is_N𝒱1
     have "V?𝒱'  EES1 = V?𝒱1'" 
       unfolding properSeparationOfViews_def by auto
     from propSepViews   N𝒱_inter_E2_is_N𝒱2
     have "V?𝒱'  EES2 = V?𝒱2'"
       unfolding properSeparationOfViews_def by auto
     from propSepViews 
     have  "C?𝒱'  EES1  C?𝒱1'"
       unfolding properSeparationOfViews_def by auto      
     from propSepViews
     have  "C?𝒱'  EES2  C?𝒱2'"
       unfolding properSeparationOfViews_def by auto
     have "N?𝒱1'  N?𝒱2' ={}"
       by auto
     
     note properSeparation_𝒱1𝒱2=‹V?𝒱'  EES1 = V?𝒱1' ‹V?𝒱'  EES2 = V?𝒱2' 
              ‹C?𝒱'  EES1  C?𝒱1' ‹C?𝒱'  EES2  C?𝒱2' ‹N?𝒱1'  N?𝒱2' ={}
    
    (*Show ES1∥ES2 is a well behaved composition w.r.t.  ?𝒱1' and ?𝒱2' *)
     have wbc1: "N?𝒱1'  EES1={}  N?𝒱2'  EES2={}"
       by auto
     
     
    from ‹SD 𝒱1 TrES1  have "BSD ?𝒱1' TrES1"      
      using validES1 validV1 BSPTaxonomyDifferentCorrections.SD_implies_BSD_for_modified_view
      unfolding  BSPTaxonomyDifferentCorrections_def by auto
    from ‹SD 𝒱2 TrES2  have "BSD ?𝒱2' TrES2"     
      using validES2 validV2 BSPTaxonomyDifferentCorrections.SD_implies_BSD_for_modified_view
      unfolding BSPTaxonomyDifferentCorrections_def by auto   
 
    from validES1 validES2 composableES1ES2   𝒱'IsViewOnE 𝒱1'IsViewOnE1 𝒱2'IsViewOnE2
         properSeparation_𝒱1𝒱2  wbc1
    have "Compositionality ES1 ES2 ?𝒱' ?𝒱1' ?𝒱2'"
      unfolding Compositionality_def
      by (simp add: properSeparationOfViews_def wellBehavedComposition_def)
    with ‹BSD ?𝒱1' TrES1 ‹BSD ?𝒱2' TrES2 have "BSD ?𝒱' Tr(ES1ES2)" 
     using Compositionality.compositionality_BSD by blast
     
   from  validES1 validES2 composeES_yields_ES validVC
   have "BSPTaxonomyDifferentCorrections (ES1ES2) 𝒱"
      unfolding BSPTaxonomyDifferentCorrections_def by auto 
    with ‹BSD ?𝒱' Tr(ES1ES2) have "SD 𝒱 Tr(ES1ES2)" 
      using BSPTaxonomyDifferentCorrections.BSD_implies_SD_for_modified_view  by auto 
  }
  thus ?thesis by auto  
qed

(*Theorem 6.4.3 Case 3 in Heiko Mantel's pdh thesis*)
theorem compositionality_SI: 
"SD 𝒱1 TrES1; SD 𝒱2 TrES2; SI 𝒱1 TrES1; SI 𝒱2 TrES2  
    SI 𝒱 (Tr(ES1  ES2))" 
proof -
  assume "SD 𝒱1 TrES1"
     and "SD 𝒱2 TrES2"
     and "SI 𝒱1 TrES1"
     and "SI 𝒱2 TrES2"
  { 
    let ?𝒱1'="V = V𝒱1  N𝒱1, N = {}, C = C𝒱1"
    let ?𝒱2'="V = V𝒱2  N𝒱2, N = {}, C = C𝒱2 "
    let ?𝒱' ="V=V𝒱  N𝒱, N={}, C=C𝒱 " 
    (*Show ?𝒱1' ?𝒱2' ?𝒱' are views on the respective set of events*)
    from validV1 have 𝒱1'IsViewOnE1: "isViewOn ?𝒱1' EES1 " 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    from validV2 have 𝒱2'IsViewOnE2: "isViewOn ?𝒱2' EES2 " 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    from VIsViewOnE have 𝒱'IsViewOnE: "isViewOn  ?𝒱' E(ES1ES2)" 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    
    (*Show ?𝒱1' and ?𝒱2' are proper separation of ⦇ V=𝒱, N={}, C=𝒱 ⦈ *)
     from propSepViews  N𝒱_inter_E1_is_N𝒱1
     have "V?𝒱'  EES1 = V?𝒱1'" 
       unfolding properSeparationOfViews_def by auto
     from propSepViews   N𝒱_inter_E2_is_N𝒱2
     have "V?𝒱'  EES2 = V?𝒱2'" 
       unfolding properSeparationOfViews_def by auto
     from propSepViews 
     have  "C?𝒱'  EES1  C?𝒱1'" 
       unfolding properSeparationOfViews_def by auto      
     from propSepViews
     have  "C?𝒱'  EES2  C?𝒱2'" 
       unfolding properSeparationOfViews_def by auto
     have "N?𝒱1'  N?𝒱2' ={}"
       by auto
     
     note properSeparation_𝒱1𝒱2=‹V?𝒱'  EES1 = V?𝒱1' ‹V?𝒱'  EES2 = V?𝒱2' 
              ‹C?𝒱'  EES1  C?𝒱1' ‹C?𝒱'  EES2  C?𝒱2' ‹N?𝒱1'  N?𝒱2' ={}
    
    (*Show ES1∥ES2 is a well behaved composition w.r.t.  ?𝒱1' and ?𝒱2' *)
     have wbc1: "N?𝒱1'  EES1={}  N?𝒱2'  EES2={}"
       by auto
     
    from ‹SD 𝒱1 TrES1  have "BSD ?𝒱1' TrES1"      
      using validES1 validV1 BSPTaxonomyDifferentCorrections.SD_implies_BSD_for_modified_view 
      unfolding  BSPTaxonomyDifferentCorrections_def by auto
    from ‹SD 𝒱2 TrES2  have "BSD ?𝒱2' TrES2"     
      using validES2 validV2 BSPTaxonomyDifferentCorrections.SD_implies_BSD_for_modified_view 
      unfolding BSPTaxonomyDifferentCorrections_def by auto  
    from ‹SI 𝒱1 TrES1  have "BSI ?𝒱1' TrES1"      
      using validES1 validV1 BSPTaxonomyDifferentCorrections.SI_implies_BSI_for_modified_view 
      unfolding  BSPTaxonomyDifferentCorrections_def by auto
    from ‹SI 𝒱2 TrES2  have "BSI ?𝒱2' TrES2"     
      using validES2 validV2 BSPTaxonomyDifferentCorrections.SI_implies_BSI_for_modified_view 
      unfolding BSPTaxonomyDifferentCorrections_def by auto   

    from validES1 validES2 composableES1ES2  𝒱'IsViewOnE 𝒱1'IsViewOnE1 𝒱2'IsViewOnE2
         properSeparation_𝒱1𝒱2  wbc1
    have "Compositionality ES1 ES2 ?𝒱' ?𝒱1' ?𝒱2'" unfolding Compositionality_def 
      by (simp add: properSeparationOfViews_def wellBehavedComposition_def)
    with ‹BSD ?𝒱1' TrES1 ‹BSD ?𝒱2' TrES2 ‹BSI  ?𝒱1' TrES1 ‹BSI ?𝒱2' TrES2
    have "BSI ?𝒱' Tr(ES1ES2)" 
     using Compositionality.compositionality_BSI by blast
     
   from  validES1 validES2 composeES_yields_ES validVC
   have "BSPTaxonomyDifferentCorrections (ES1ES2) 𝒱"
      unfolding BSPTaxonomyDifferentCorrections_def by auto 
    with ‹BSI ?𝒱' Tr(ES1ES2) have "SI 𝒱 Tr(ES1ES2)" 
      using BSPTaxonomyDifferentCorrections.BSI_implies_SI_for_modified_view  by auto 
  }
  thus ?thesis by auto  
qed


(*Theorem 6.4.3 Case 4 in Heiko Mantel's pdh thesis*)
theorem compositionality_SIA: 
"SD 𝒱1 TrES1; SD 𝒱2 TrES2; SIA ρ1 𝒱1 TrES1; SIA ρ2 𝒱2 TrES2; 
  (ρ1 𝒱1)  (ρ 𝒱)  EES1; (ρ2 𝒱2)  (ρ 𝒱)  EES2 
    SIA ρ 𝒱 (Tr(ES1  ES2))"
proof -
  assume "SD 𝒱1 TrES1"
     and "SD 𝒱2 TrES2"
     and "SIA ρ1 𝒱1 TrES1"
     and "SIA ρ2 𝒱2 TrES2"
     and "(ρ1 𝒱1)  (ρ 𝒱)  EES1"
     and "(ρ2 𝒱2)  (ρ 𝒱)  EES2"
  { 
    let ?𝒱1' ="V = V𝒱1  N𝒱1, N = {}, C = C𝒱1"
    let ?𝒱2'="V = V𝒱2  N𝒱2, N = {}, C = C𝒱2 "
    let ?𝒱' ="V=V𝒱  N𝒱, N={}, C=C𝒱 " 
    
    (*Fix some intermediate rho's such that (ρ1' ?𝒱1') = (ρ1 𝒱1), (ρ2' ?𝒱2') = (ρ2 𝒱2)  and
      (ρ' ?𝒱') = (ρ 𝒱) hold.*)
    let "?ρ1'::'a Rho" ="λ𝒱. if 𝒱=?𝒱1' then ρ1 𝒱1  else {}"
    let "?ρ2'::'a Rho" ="λ𝒱. if 𝒱=?𝒱2' then ρ2 𝒱2  else {}"
    let "?ρ'::'a Rho" ="λ𝒱'. if 𝒱'=?𝒱' then ρ 𝒱  else {}"
    
    have "(?ρ1' ?𝒱1') = (ρ1 𝒱1)" by simp 
    have "(?ρ2' ?𝒱2') = (ρ2 𝒱2)" by simp
    have "(?ρ' ?𝒱') = (ρ 𝒱)" by simp

    (*Show ?𝒱1' ?𝒱2' ?𝒱' are views on the respective set of events*)
    from validV1 have 𝒱1'IsViewOnE1: "isViewOn ?𝒱1' EES1 " 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    from validV2 have 𝒱2'IsViewOnE2: "isViewOn ?𝒱2' EES2 " 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    from VIsViewOnE have 𝒱'IsViewOnE: "isViewOn  ?𝒱' E(ES1ES2)" 
      unfolding isViewOn_def V_valid_def  VN_disjoint_def NC_disjoint_def VC_disjoint_def by auto
    
    (*Show ?𝒱1' and ?𝒱2' are proper separation of ⦇ V=𝒱, N={}, C=𝒱 ⦈ *)
     from propSepViews  N𝒱_inter_E1_is_N𝒱1
     have "V?𝒱'  EES1 = V?𝒱1'"
       unfolding properSeparationOfViews_def by auto
     from propSepViews   N𝒱_inter_E2_is_N𝒱2
     have "V?𝒱'  EES2 = V?𝒱2'"
       unfolding properSeparationOfViews_def by auto
     from propSepViews 
     have  "C?𝒱'  EES1  C?𝒱1'"
       unfolding properSeparationOfViews_def by auto      
     from propSepViews
     have  "C?𝒱'  EES2  C?𝒱2'"
       unfolding properSeparationOfViews_def by auto
     have "N?𝒱1'  N?𝒱2' ={}"
       by auto
     
     note properSeparation_𝒱1𝒱2=‹V?𝒱'  EES1 = V?𝒱1' ‹V?𝒱'  EES2 = V?𝒱2' 
              ‹C?𝒱'  EES1  C?𝒱1' ‹C?𝒱'  EES2  C?𝒱2' ‹N?𝒱1'  N?𝒱2' ={}
    
    (*Show ES1∥ES2 is a well behaved composition w.r.t.  ?𝒱1' and ?𝒱2' *)
     have wbc1: "N?𝒱1'  EES1={}  N?𝒱2'  EES2={}" 
       by auto
    
      
    from ‹SD 𝒱1 TrES1  have "BSD ?𝒱1' TrES1"      
      using validES1 validV1 BSPTaxonomyDifferentCorrections.SD_implies_BSD_for_modified_view 
      unfolding  BSPTaxonomyDifferentCorrections_def by auto
    from ‹SD 𝒱2 TrES2  have "BSD ?𝒱2' TrES2"     
      using validES2 validV2 BSPTaxonomyDifferentCorrections.SD_implies_BSD_for_modified_view 
      unfolding BSPTaxonomyDifferentCorrections_def by auto 

    from ‹SIA ρ1 𝒱1 TrES1 (?ρ1' ?𝒱1') = (ρ1 𝒱1)  have "BSIA ?ρ1' ?𝒱1' TrES1"      
      using validES1 validV1 BSPTaxonomyDifferentCorrections.SIA_implies_BSIA_for_modified_view 
      unfolding  BSPTaxonomyDifferentCorrections_def by fastforce
    from ‹SIA ρ2 𝒱2 TrES2 (?ρ2' ?𝒱2') = (ρ2 𝒱2)  have "BSIA ?ρ2' ?𝒱2' TrES2"     
      using validES2 validV2 BSPTaxonomyDifferentCorrections.SIA_implies_BSIA_for_modified_view 
      unfolding BSPTaxonomyDifferentCorrections_def by fastforce   

    from validES1 validES2 composableES1ES2  𝒱'IsViewOnE 𝒱1'IsViewOnE1 𝒱2'IsViewOnE2
         properSeparation_𝒱1𝒱2  wbc1
    have "Compositionality ES1 ES2 ?𝒱' ?𝒱1' ?𝒱2'" 
      unfolding Compositionality_def 
      by (simp add: properSeparationOfViews_def wellBehavedComposition_def)
    from (ρ1 𝒱1)  (ρ 𝒱)  EES1 (?ρ1' ?𝒱1') = (ρ1 𝒱1) (?ρ' ?𝒱') = (ρ 𝒱)
    have "?ρ1' ?𝒱1'    ?ρ'  ?𝒱'  EES1"
      by auto 
    from (ρ2 𝒱2)  (ρ 𝒱)  EES2 (?ρ2' ?𝒱2') = (ρ2 𝒱2) (?ρ' ?𝒱') = (ρ 𝒱)
    have "?ρ2' ?𝒱2'    ?ρ'  ?𝒱'  EES2"
      by auto   

    from ‹Compositionality ES1 ES2 ?𝒱' ?𝒱1' ?𝒱2' ‹BSD ?𝒱1' TrES1 ‹BSD ?𝒱2' TrES2 
          ‹BSIA ?ρ1' ?𝒱1' TrES1 ‹BSIA ?ρ2' ?𝒱2' TrES2 
          ?ρ1' ?𝒱1'    ?ρ'  ?𝒱'  EES1 ?ρ2' ?𝒱2'    ?ρ'  ?𝒱'  EES2
    have "BSIA ?ρ' ?𝒱' Tr(ES1ES2)"
      using Compositionality.compositionality_BSIA by fastforce
      
    from  validES1 validES2 composeES_yields_ES validVC 
    have "BSPTaxonomyDifferentCorrections (ES1ES2) 𝒱" 
      unfolding BSPTaxonomyDifferentCorrections_def by auto 
    with ‹BSIA ?ρ' ?𝒱' Tr(ES1ES2) (?ρ' ?𝒱') = (ρ 𝒱) have "SIA ρ 𝒱 Tr(ES1ES2)" 
      using BSPTaxonomyDifferentCorrections.BSIA_implies_SIA_for_modified_view  by fastforce
  }
  thus ?thesis
    by auto  
qed
end

end